Browse Source

* when removing a method from the synchronization queue using TThread.RemoveQueuedEvent then both the Code and the Data need to match (Delphi does the same)
+ added test

git-svn-id: trunk@47007 -

svenbarth 4 years ago
parent
commit
a624348692
3 changed files with 78 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 5 1
      rtl/objpas/classes/classes.inc
  3. 72 0
      tests/tbs/tb0678.pp

+ 1 - 0
.gitattributes

@@ -13351,6 +13351,7 @@ tests/tbs/tb0675.pp svneol=native#text/pascal
 tests/tbs/tb0676.pp svneol=native#text/pascal
 tests/tbs/tb0676a.pp svneol=native#text/plain
 tests/tbs/tb0677.pp svneol=native#text/pascal
+tests/tbs/tb0678.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain

+ 5 - 1
rtl/objpas/classes/classes.inc

@@ -609,7 +609,11 @@ begin
         Continue;
       end;
       { then check for the method }
-      if Assigned(aMethod) and (entry^.Method <> aMethod) then begin
+      if Assigned(aMethod) and
+          (
+            (TMethod(entry^.Method).Code <> TMethod(aMethod).Code) or
+            (TMethod(entry^.Method).Data <> TMethod(aMethod).Data)
+          ) then begin
         lastentry := entry;
         entry := entry^.Next;
         Continue;

+ 72 - 0
tests/tbs/tb0678.pp

@@ -0,0 +1,72 @@
+{%skiptarget=$nothread }
+
+program tqueue;
+
+{$mode objfpc}
+
+uses
+{$ifdef unix}
+  cthreads,
+{$endif}
+  SysUtils, Classes;
+
+type
+  TTest = class
+    procedure DoTest;
+  end;
+
+  TTestThread = class(TThread)
+  protected
+    procedure Execute; override;
+  end;
+
+var
+  count: LongInt = 0;
+
+procedure TTest.DoTest;
+begin
+  Inc(count);
+end;
+
+var
+  t1, t2: TTest;
+
+procedure TTestThread.Execute;
+var
+  method: TMethod;
+begin
+  Queue(@t1.DoTest);
+  Queue(@t2.DoTest);
+
+  { should remove nothing }
+  method.Code := @TTest.DoTest;
+  method.Data := Nil;
+
+  RemoveQueuedEvents(TThreadMethod(method));
+
+  { should remove only one }
+  RemoveQueuedEvents(@t1.DoTest);
+end;
+
+var
+  t: TTestThread;
+begin
+  t := TTestThread.Create(True);
+  try
+    t1 := TTest.Create;
+    t2 := TTest.Create;
+
+    t.Start;
+    t.WaitFor;
+
+    CheckSynchronize;
+
+    if count <> 1 then
+      Halt(1);
+  finally
+    t1.Free;
+    t2.Free;
+    t.Free;
+  end;
+end.
+