Project X raised exception class "EThread" with message:
'Suspend one thread inside another one is unsupported (because it is unsafe and deadlock prone) by *nix and posix operation systems'
поток объявлен в отдельном модуле так
- Код: Выделить всё
unit Simplethread;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
interface
uses
Classes;
type
TSimpleThread = class(Tthread)
procedure dummy;
private
protected
procedure Execute; override;
end;
implementation
uses SysUtils,main...;
Пробою
- Код: Выделить всё
unit gvar
....
uses Simplethread...;
....
var
p1:T
....
- Код: Выделить всё
program Myprogram;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
{$ifdef FPC}
{$ifdef mswindows}{$apptype gui}{$endif}
{$endif}
uses
{$ifdef FPC} {$ifdef linux}cthreads, {$endif} {$endif}
msegui,mseforms,syncobjs,mseguiglob,main,gvar,Simplethread...;
begin
p1:= TSimpleThread .Create(False);
p1.Suspend;
В итоге получаю исключение
PS:fpc 2.4+mseide+msegui2.4
Добавлено спустя 2 часа 23 минуты 5 секунд:
из Classes от Kylix
About Suspend and Resume. POSIX does not support suspending/resuming a thread.
Suspending a thread is considerd dangerous since it is not guaranteed where the
thread would be suspend. It might be holding a lock, mutex or it might be inside
a critical section. In order to simulate it in Linux we've used signals. To
suspend, a thread SIGSTOP is sent and to resume, SIGCONT is sent. Note that this
is Linux only i.e. according to POSIX if a thread receives SIGSTOP then the
entire process is stopped. However Linux doesn't entirely exhibit the POSIX-mandated
behaviour. If and when it fully complies with the POSIX standard then suspend
and resume won't work
Интересна последняя сторка
Вольный перевод Если Linux следовал Posix, то функции Resume, Suspend не будут рабать
Для сравнения Kylix
- Код: Выделить всё
procedure TThread.Suspend;
begin
FSuspended := True;
CheckThreadError(pthread_kill(FThreadID, SIGSTOP));
end;
procedure TThread.Resume;
begin
if not FInitialSuspendDone then
begin
FInitialSuspendDone := True;
sem_post(FCreateSuspendedSem);
end else
CheckThreadError(pthread_kill(FThreadID, SIGCONT));
FSuspended := False;
end;
FPC
- Код: Выделить всё
procedure TThread.Suspend;
begin
if FThreadID = GetCurrentThreadID then
begin
if not FSuspended and
(InterLockedExchange(longint(FSuspended),ord(true)) = ord(false)) then
CurrentTM.SemaphoreWait(FSem)
end
else
begin
Raise EThread.create('Suspending one thread from inside another one is unsupported (because it is unsafe and deadlock prone) by *nix and posix operating systems');
// FSuspendedExternal := true;
// SuspendThread(FHandle);
end;
end;
procedure TThread.Resume;
begin
if (not FSuspendedExternal) then
begin
if FSuspended and
(InterLockedExchange(longint(FSuspended),ord(false)) = ord(true)) then
begin
WRITE_DEBUG('resuming ',ptruint(self));
CurrentTM.SemaphorePost(FSem);
end
end
else
begin
raise EThread.create('External suspending is not supported under *nix/posix, so trying to resume from from an external suspension should never happen');
// FSuspendedExternal := false;
// ResumeThread(FHandle);
end;
end;
PS:
Неужели проще использовать RTL от Kylix (особенно под Linux) чем пользоваться не доделанными модулями от fpc
