Browse Source

* second fix for Mantis #30626: also search in parent classes for a suitable pre-existing specialization
+ added test

git-svn-id: trunk@35014 -

svenbarth 8 years ago
parent
commit
6ba85c2a70
3 changed files with 55 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 12 1
      compiler/pgenutil.pas
  3. 42 0
      tests/webtbs/tw30626b.pp

+ 1 - 0
.gitattributes

@@ -15256,6 +15256,7 @@ tests/webtbs/tw30552.pp svneol=native#text/pascal
 tests/webtbs/tw30570.pp svneol=native#text/plain
 tests/webtbs/tw30572.pp svneol=native#text/plain
 tests/webtbs/tw30626.pp svneol=native#text/pascal
+tests/webtbs/tw30626b.pp svneol=native#text/pascal
 tests/webtbs/tw3063.pp svneol=native#text/plain
 tests/webtbs/tw3064.pp svneol=native#text/plain
 tests/webtbs/tw30666.pp svneol=native#text/plain

+ 12 - 1
compiler/pgenutil.pas

@@ -708,6 +708,7 @@ uses
         ufinalspecializename : tidstring;
         prettyname : ansistring;
         generictypelist : tfphashobjectlist;
+        srsymtable,
         specializest : tsymtable;
         hashedid : thashedidstring;
         tempst : tglobalsymtable;
@@ -881,7 +882,17 @@ uses
           begin
             hashedid.id:=ufinalspecializename;
 
-            srsym:=tsym(specializest.findwithhash(hashedid));
+            if specializest.symtabletype=objectsymtable then
+              begin
+                { search also in parent classes }
+                if not assigned(current_genericdef) or (current_genericdef.typ<>objectdef) then
+                  internalerror(2016112901);
+                if not searchsym_in_class(tobjectdef(current_genericdef),tobjectdef(current_genericdef),ufinalspecializename,srsym,srsymtable,[]) then
+                  srsym:=nil;
+              end
+            else
+              srsym:=tsym(specializest.findwithhash(hashedid));
+
             if assigned(srsym) then
               begin
                 retrieve_genericdef_or_procsym(srsym,result,psym);

+ 42 - 0
tests/webtbs/tw30626b.pp

@@ -0,0 +1,42 @@
+{ %NORUN }
+
+program tw30626b;
+
+{$mode objfpc}
+
+type
+  generic IBase<T> = interface(IUnknown)
+    function Test: specialize IBase<T>;
+  end;
+
+  generic TBase<T> = class(TInterfacedObject, specialize IBase<T>)
+  public
+    function Test: specialize IBase<T>; virtual;
+  end;
+
+  generic TDerived<T> = class(specialize TBase<T>)
+  public
+    function Test: specialize IBase<T>; override;
+  end;
+
+function TBase.Test: specialize IBase<T>;
+begin
+ result := specialize TDerived<T>.Create;
+end;
+
+function TDerived.Test: specialize IBase<T>;
+begin
+ result := specialize TDerived<T>.Create;
+end;
+
+type
+  IIntegerBase = specialize IBase<Integer>;
+
+var
+  Intf, Intf2: IIntegerBase;
+begin
+  Intf:= specialize TDerived<Integer>.Create;
+  Intf2:= Intf.Test;
+end.
+
+