paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 20:50:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

* prevent freeing in both threads at the same time in theapthread test

Browse Source 
git-svn-id: trunk@7415 -
This commit is contained in:
micha 2007-05-21 20:39:33 +00:00
parent 023a3167c2
commit 7d109a1a33
1 changed files with 7 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
tests/test/theapthread.pp
View File

@ -21,6 +21,7 @@ var
writeindex: integer;
fifo: array[0..1023] of pointer;
done: boolean;
freefifolock: trtlcriticalsection;
type
ttestarray = array[0..31] of pointer;
@ -79,7 +80,9 @@ begin
end;
end;
freearray(p, sizeof(p) div sizeof(pointer));
entercriticalsection(freefifolock);
freearray(fifo, sizeof(fifo) div sizeof(pointer));
leavecriticalsection(freefifolock);
end;
procedure consumer;
@ -91,6 +94,7 @@ begin
i := 0;
j := 0;
k := 0;
entercriticalsection(freefifolock);
while not done do
begin
if readindex <> writeindex then
@ -108,6 +112,7 @@ begin
end;
end;
end;
leavecriticalsection(freefifolock);
freearray(p, sizeof(p) div sizeof(pointer));
end;
@ -127,6 +132,7 @@ var
produce_thread: tproducethread;
consume_thread: tconsumethread;
begin
initcriticalsection(freefifolock);
done := false;
filldword(fifo, sizeof(fifo) div sizeof(dword), 0);
readindex := 0;
@ -139,4 +145,5 @@ begin
consume_thread.waitfor;
produce_thread.free;
consume_thread.free;
donecriticalsection(freefifolock);
end.