浏览代码

* fix for Mantis #30830: also remove unregistered specializations from the procsym's deflist when they're removed to avoid an access to freed data
+ added tests (adjusted original test plus a mode Delphi variant)

git-svn-id: trunk@35012 -

svenbarth 8 年之前
父节点
当前提交
ebfeb5b62a
共有 4 个文件被更改,包括 95 次插入1 次删除
  1. 2 0
      .gitattributes
  2. 15 1
      compiler/htypechk.pas
  3. 39 0
      tests/webtbs/tw30830a.pp
  4. 39 0
      tests/webtbs/tw30830b.pp

+ 2 - 0
.gitattributes

@@ -15263,6 +15263,8 @@ tests/webtbs/tw30706.pp svneol=native#text/plain
 tests/webtbs/tw3073.pp svneol=native#text/plain
 tests/webtbs/tw3082.pp svneol=native#text/plain
 tests/webtbs/tw3083.pp svneol=native#text/plain
+tests/webtbs/tw30830a.pp svneol=native#text/pascal
+tests/webtbs/tw30830b.pp svneol=native#text/pascal
 tests/webtbs/tw30831.pp svneol=native#text/pascal
 tests/webtbs/tw30832.pp svneol=native#text/pascal
 tests/webtbs/tw30889.pp svneol=native#text/pascal

+ 15 - 1
compiler/htypechk.pas

@@ -2141,6 +2141,8 @@ implementation
       var
         hpnext,
         hp : pcandidate;
+        psym : tprocsym;
+        i : longint;
       begin
         FIgnoredCandidateProcs.free;
         hp:=FCandidateProcs;
@@ -2149,7 +2151,19 @@ implementation
            hpnext:=hp^.next;
            { free those procdef specializations that are not owned (thus were discarded) }
            if hp^.data.is_specialization and not hp^.data.is_registered then
-             hp^.data.free;
+             begin
+               { also remove the procdef from its symbol's procdeflist }
+               psym:=tprocsym(hp^.data.procsym);
+               for i:=0 to psym.procdeflist.count-1 do
+                 begin
+                   if psym.procdeflist[i]=hp^.data then
+                     begin
+                       psym.procdeflist.delete(i);
+                       break;
+                     end;
+                 end;
+               hp^.data.free;
+             end;
            dispose(hp);
            hp:=hpnext;
          end;

+ 39 - 0
tests/webtbs/tw30830a.pp

@@ -0,0 +1,39 @@
+{ %NORUN }
+
+program tw30830a;
+
+{$mode objfpc}
+
+type
+  generic TBase<T> = class
+    procedure Test1(const a: T);
+  end;
+
+  generic TDerived<T> = class(specialize TBase<T>)
+    procedure Test2(const a: T);
+  end;
+
+procedure TBase.Test1(const a: T);
+begin
+end;
+
+procedure TDerived.Test2(const a: T);
+begin
+end;
+
+generic procedure Test<T>(aIntf: specialize TBase<T>); // works
+begin
+end;
+
+generic procedure Test<T>(aIntf: specialize TDerived<T>); // SIGSEGV :(
+begin
+end;
+
+var
+  b: specialize TBase<LongInt>;
+  d: specialize TDerived<LongInt>;
+begin
+  specialize Test<LongInt>(b);
+  specialize Test<LongInt>(d);
+end.
+

+ 39 - 0
tests/webtbs/tw30830b.pp

@@ -0,0 +1,39 @@
+{ %NORUN }
+
+program tw30830a;
+
+{$mode delphi}
+
+type
+  TBase<T> = class
+    procedure Test1(const a: T);
+  end;
+
+  TDerived<T> = class(TBase<T>)
+    procedure Test2(const a: T);
+  end;
+
+procedure TBase<T>.Test1(const a: T);
+begin
+end;
+
+procedure TDerived<T>.Test2(const a: T);
+begin
+end;
+
+procedure Test<T>(aIntf: TBase<T>); overload; // works
+begin
+end;
+
+procedure Test<T>(aIntf: TDerived<T>); overload; // SIGSEGV :(
+begin
+end;
+
+var
+  b: TBase<LongInt>;
+  d: TDerived<LongInt>;
+begin
+  Test<LongInt>(b);
+  Test<LongInt>(d);
+end.
+