Fix for Mantis #25041 . Correctly set CurrentThreadVar for those tthread.inc incarnations that don't use the default ThreadProc in classes.inc (this should be changed in the future though...). In addition to Unix systems as described by the bug report this also involved BeOS and Netware LibC.

+ added test

git-svn-id: trunk@25511 -
This commit is contained in:
svenbarth 2013-09-17 18:02:12 +00:00
parent 900afaddea
commit fbceb574eb
5 changed files with 49 additions and 0 deletions

1
.gitattributes vendored
View File

@ -11864,6 +11864,7 @@ tests/test/tthlp6.pp svneol=native#text/pascal
tests/test/tthlp7.pp svneol=native#text/pascal tests/test/tthlp7.pp svneol=native#text/pascal
tests/test/tthlp8.pp svneol=native#text/pascal tests/test/tthlp8.pp svneol=native#text/pascal
tests/test/tthlp9.pp svneol=native#text/pascal tests/test/tthlp9.pp svneol=native#text/pascal
tests/test/tthread1.pp svneol=native#text/pascal
tests/test/ttpara1.pp svneol=native#text/plain tests/test/ttpara1.pp svneol=native#text/plain
tests/test/ttpara2.pp svneol=native#text/plain tests/test/ttpara2.pp svneol=native#text/plain
tests/test/ttypeconvtypes.pp svneol=native#text/pascal tests/test/ttypeconvtypes.pp svneol=native#text/pascal

View File

@ -151,6 +151,7 @@ begin
while Thread.FHandle = 0 do fpsleep(1); while Thread.FHandle = 0 do fpsleep(1);
if Thread.FSuspended then Thread.suspend(); if Thread.FSuspended then Thread.suspend();
try try
CurrentThreadVar := Thread;
Thread.Execute; Thread.Execute;
except except
Thread.FFatalException := TObject(AcquireExceptionObject); Thread.FFatalException := TObject(AcquireExceptionObject);
@ -423,10 +424,12 @@ begin
if LThread.FInitialSuspended then begin if LThread.FInitialSuspended then begin
SemaphoreWait(LThread.FSem); SemaphoreWait(LThread.FSem);
if not LThread.FInitialSuspended then begin if not LThread.FInitialSuspended then begin
CurrentThreadVar := LThread;
WRITE_DEBUG('going into LThread.Execute'); WRITE_DEBUG('going into LThread.Execute');
LThread.Execute; LThread.Execute;
end; end;
end else begin end else begin
CurrentThreadVar := LThread;
WRITE_DEBUG('going into LThread.Execute'); WRITE_DEBUG('going into LThread.Execute');
LThread.Execute; LThread.Execute;
end; end;

View File

@ -226,10 +226,12 @@ begin
if LThread.FInitialSuspended then begin if LThread.FInitialSuspended then begin
LThread.Suspend; LThread.Suspend;
if not LThread.FInitialSuspended then begin if not LThread.FInitialSuspended then begin
CurrentThreadVar := LThread;
WRITE_DEBUG('going into LThread.Execute'#13#10); WRITE_DEBUG('going into LThread.Execute'#13#10);
LThread.Execute; LThread.Execute;
end; end;
end else begin end else begin
CurrentThreadVar := LThread;
WRITE_DEBUG('going into LThread.Execute'#13#10); WRITE_DEBUG('going into LThread.Execute'#13#10);
LThread.Execute; LThread.Execute;
end; end;

View File

@ -111,6 +111,7 @@ begin
if not LThread.FSuspended then if not LThread.FSuspended then
begin begin
LThread.FInitialSuspended := false; LThread.FInitialSuspended := false;
CurrentThreadVar := LThread;
WRITE_DEBUG('going into LThread.Execute'); WRITE_DEBUG('going into LThread.Execute');
LThread.Execute; LThread.Execute;
end end
@ -125,6 +126,7 @@ begin
LThread.FSuspendedInternal := true; LThread.FSuspendedInternal := true;
WRITE_DEBUG('waiting for SuspendedInternal - ', LThread.ClassName); WRITE_DEBUG('waiting for SuspendedInternal - ', LThread.ClassName);
CurrentTM.SemaphoreWait(LThread.FSem); CurrentTM.SemaphoreWait(LThread.FSem);
CurrentThreadVar := LThread;
WRITE_DEBUG('going into LThread.Execute - ', LThread.ClassName); WRITE_DEBUG('going into LThread.Execute - ', LThread.ClassName);
LThread.Execute; LThread.Execute;
end; end;

41
tests/test/tthread1.pp Normal file
View File

@ -0,0 +1,41 @@
program tthread1;
{$mode objfpc}
uses
{$ifdef unix}
cthreads,
{$endif}
Classes;
type
TTestThread = class(TThread)
protected
procedure Execute; override;
public
property ReturnValue;
end;
procedure TTestThread.Execute;
var
thrd: TThread;
begin
thrd := CurrentThread;
if thrd <> Self then
ReturnValue := 1
else
ReturnValue := 0;
end;
var
t: TTestThread;
begin
t := TTestThread.Create(False);
try
t.WaitFor;
ExitCode := t.ReturnValue;
finally
t.Free;
end;
Writeln(ExitCode);
end.