Răsfoiți Sursa

* if a call inside a generic's code that involves generic type arguments can't be clearly determined then postpone it till specialization in the hope that the type will be clear then
+ added test

git-svn-id: trunk@47686 -

svenbarth 4 ani în urmă
părinte
comite
69e6f3dcbb
3 a modificat fișierele cu 73 adăugiri și 3 ștergeri
  1. 1 0
      .gitattributes
  2. 37 3
      compiler/ncal.pas
  3. 35 0
      tests/test/tgenfunc23.pp

+ 1 - 0
.gitattributes

@@ -15172,6 +15172,7 @@ tests/test/tgenfunc2.pp svneol=native#text/pascal
 tests/test/tgenfunc20.pp svneol=native#text/pascal
 tests/test/tgenfunc21.pp svneol=native#text/pascal
 tests/test/tgenfunc22.pp svneol=native#text/pascal
+tests/test/tgenfunc23.pp svneol=native#text/pascal
 tests/test/tgenfunc3.pp svneol=native#text/pascal
 tests/test/tgenfunc4.pp svneol=native#text/pascal
 tests/test/tgenfunc5.pp svneol=native#text/pascal

+ 37 - 3
compiler/ncal.pas

@@ -3575,6 +3575,18 @@ implementation
 
 
     function tcallnode.pass_typecheck:tnode;
+
+      function is_undefined_recursive(def:tdef):boolean;
+        begin
+          { might become more refined in the future }
+          if def.typ=undefineddef then
+            result:=true
+          else if def.typ=arraydef then
+            result:=is_undefined_recursive(tarraydef(def).elementdef)
+          else
+            result:=false;
+        end;
+
       var
         candidates : tcallcandidates;
         oldcallnode : tcallnode;
@@ -3584,6 +3596,7 @@ implementation
         paraidx,
         cand_cnt : integer;
         i : longint;
+        ignoregenericparacall,
         ignorevisibility,
         is_const : boolean;
         statements : tstatementnode;
@@ -3771,12 +3784,33 @@ implementation
                       { Multiple candidates left? }
                       if cand_cnt>1 then
                        begin
-                         CGMessage(type_e_cant_choose_overload_function);
+                         { if we're inside a generic and call another function
+                           with generic types as arguments we don't complain in
+                           the generic, but only during the specialization }
+                         ignoregenericparacall:=false;
+                         if df_generic in current_procinfo.procdef.defoptions then
+                           begin
+                             pt:=tcallparanode(left);
+                             while assigned(pt) do
+                              begin
+                                if is_undefined_recursive(pt.resultdef) then
+                                  begin
+                                    ignoregenericparacall:=true;
+                                    break;
+                                  end;
+                                pt:=tcallparanode(pt.right);
+                              end;
+                           end;
+
+                         if not ignoregenericparacall then
+                           begin
+                             CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
-                         candidates.dump_info(V_Hint);
+                             candidates.dump_info(V_Hint);
 {$else EXTDEBUG}
-                         candidates.list(false);
+                             candidates.list(false);
 {$endif EXTDEBUG}
+                           end;
                          { we'll just use the first candidate to make the
                            call }
                        end;

+ 35 - 0
tests/test/tgenfunc23.pp

@@ -0,0 +1,35 @@
+program tgenfunc;
+
+{$mode objfpc}
+
+var
+  TestTCalled: LongInt;
+  TestArrayOfTCalled: LongInt;
+
+generic procedure Test<T>(const aArg: T);
+begin
+  Inc(TestTCalled);
+end;
+
+generic procedure Test<T>(const aArg: array of T);
+var
+  i: SizeInt;
+begin
+  for i := 0 to High(aArg) do begin
+    specialize Test<T>(aArg[i]);
+  end;
+  Inc(TestArrayOfTCalled);
+end;
+
+begin
+  TestTCalled := 0;
+  TestArrayOfTCalled := 0;
+  specialize Test<LongInt>(1);
+  if TestTCalled <> 1 then
+    Halt(1);
+  specialize Test<LongInt>([1, 2, 3]);
+  if TestArrayOfTCalled <> 1 then
+    Halt(2);
+  if TestTCalled <> 4 then
+    Halt(3);
+end.