Browse Source

* fix #39679 and fix #39680: for implicit specializations a parameter used in a call might also inherit in some depth from a specialization used as parameter type
+ added tests

Sven/Sarah Barth 3 years ago
parent
commit
66bac7c415
3 changed files with 79 additions and 4 deletions
  1. 30 4
      compiler/pgenutil.pas
  2. 28 0
      tests/webtbs/tw39679.pp
  3. 21 0
      tests/webtbs/tw39680.pp

+ 30 - 4
compiler/pgenutil.pas

@@ -1004,12 +1004,39 @@ uses
           newparams.free;
           newparams.free;
         end;
         end;
 
 
+      function maybe_inherited_specialization(givendef,desireddef:tstoreddef;out basedef:tstoreddef):boolean;
+        begin
+          result:=false;
+          basedef:=nil;
+          if givendef.typ<>objectdef then
+            begin
+              result:=givendef.is_specialization and (givendef.genericdef=desireddef.genericdef);
+              if result then
+                basedef:=givendef;
+            end
+          else
+            begin
+              while assigned(givendef) do
+                begin
+                  if givendef.is_specialization and (givendef.genericdef=desireddef.genericdef) then
+                    begin
+                      basedef:=givendef;
+                      result:=true;
+                      break;
+                    end;
+
+                  givendef:=tobjectdef(givendef).childof;
+                end;
+            end;
+        end;
+
       { compare generic parameters <T> with call node parameters. }
       { compare generic parameters <T> with call node parameters. }
       function is_possible_specialization(callerparams:tfplist;genericdef:tprocdef;out unnamed_syms:tfplist;out genericparams:tfphashlist):boolean;
       function is_possible_specialization(callerparams:tfplist;genericdef:tprocdef;out unnamed_syms:tfplist;out genericparams:tfphashlist):boolean;
         var
         var
           i,j,
           i,j,
           count : integer;
           count : integer;
           paravar : tparavarsym;
           paravar : tparavarsym;
+          base_def : tstoreddef;
           target_def,
           target_def,
           caller_def : tdef;
           caller_def : tdef;
           target_key : string;
           target_key : string;
@@ -1127,11 +1154,10 @@ uses
                   target_def:=tobjectdef(target_def).childof;
                   target_def:=tobjectdef(target_def).childof;
                 end
                 end
               { handle generic specializations }
               { handle generic specializations }
-              else if tstoreddef(caller_def).is_specialization and 
-                tstoreddef(target_def).is_specialization and
-                (tstoreddef(caller_def).genericdef=tstoreddef(target_def).genericdef) then
+              else if tstoreddef(target_def).is_specialization and
+                maybe_inherited_specialization(tstoreddef(caller_def),tstoreddef(target_def),base_def) then
                 begin
                 begin
-                  handle_specializations(genericparams,tstoreddef(target_def),tstoreddef(caller_def));
+                  handle_specializations(genericparams,tstoreddef(target_def),base_def);
                   continue;
                   continue;
                 end
                 end
               { handle all other generic params }
               { handle all other generic params }

+ 28 - 0
tests/webtbs/tw39679.pp

@@ -0,0 +1,28 @@
+{ %NORUN }
+
+program tw39679;
+
+{$mode objfpc}{$H+}
+{$ModeSwitch implicitfunctionspecialization}
+
+type
+  generic TBase<T> = class(TObject);
+  generic TChild<T> = class(specialize TBase<T>);
+  TLongIntChild = class(specialize TChild<LongInt>);
+  TLongIntBase = class(specialize TBase<LongInt>);
+
+generic procedure Foo<T>(lst: specialize TBase<T>);
+begin
+end;
+
+var
+  lst: specialize TChild<Integer>;
+  lst2: TLongIntChild;
+  lst3: TLongIntBase;
+begin
+  specialize Foo<Integer>(lst); // works
+  Foo(lst); // Error
+  Foo(lst2);
+  Foo(lst3);
+end.
+

+ 21 - 0
tests/webtbs/tw39680.pp

@@ -0,0 +1,21 @@
+{ %NORUN }
+
+program tw39680;
+
+{$mode objfpc}{$H+}
+{$ModeSwitch implicitfunctionspecialization}
+
+uses
+  Generics.Collections;
+
+generic procedure Foo<T>(lst: specialize TEnumerable<T>);
+begin
+end;
+
+var
+  lst: specialize TList<Integer>; // Inherits from TEnumerable
+begin
+  Foo(lst); // Error
+  specialize Foo<Integer>(lst); // works
+end.
+