--- Merging r45972 into '.':

U    compiler/defcmp.pas
--- Recording mergeinfo for merge of r45972 into '.':
 U   .
--- Merging r47101 into '.':
U    compiler/pexpr.pas
A    tests/webtbs/tw37844.pp
--- Recording mergeinfo for merge of r47101 into '.':
 G   .
--- Merging r47253 into '.':
G    compiler/defcmp.pas
A    tests/webtbs/tw38012.pp
--- Recording mergeinfo for merge of r47253 into '.':
 G   .
--- Merging r47424 into '.':
U    compiler/pdecsub.pas
A    tests/webtbs/tw38083.pp
--- Recording mergeinfo for merge of r47424 into '.':
 G   .
--- Merging r47425 into '.':
U    compiler/nflw.pas
A    tests/webtbs/tw38058.pp
--- Recording mergeinfo for merge of r47425 into '.':
 G   .
--- Merging r47686 into '.':
U    compiler/ncal.pas
A    tests/test/tgenfunc23.pp
--- Recording mergeinfo for merge of r47686 into '.':
 G   .

git-svn-id: branches/fixes_3_2@47803 -

.gitattributes

@@ -14558,6 +14558,7 @@ tests/test/tgenfunc17.pp svneol=native#text/pascal
 tests/test/tgenfunc18.pp svneol=native#text/pascal
 tests/test/tgenfunc19.pp svneol=native#text/pascal
 tests/test/tgenfunc2.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
@@ -17799,10 +17800,14 @@ tests/webtbs/tw3778.pp svneol=native#text/plain
 tests/webtbs/tw3780.pp svneol=native#text/plain
 tests/webtbs/tw37806.pp svneol=native#text/pascal
 tests/webtbs/tw3782.pp svneol=native#text/plain
+tests/webtbs/tw37844.pp svneol=native#text/pascal
 tests/webtbs/tw37949.pp svneol=native#text/pascal
 tests/webtbs/tw3796.pp svneol=native#text/plain
+tests/webtbs/tw38012.pp svneol=native#text/pascal
 tests/webtbs/tw3805.pp svneol=native#text/plain
+tests/webtbs/tw38058.pp svneol=native#text/pascal
 tests/webtbs/tw38069.pp svneol=native#text/pascal
+tests/webtbs/tw38083.pp svneol=native#text/pascal
 tests/webtbs/tw3814.pp svneol=native#text/plain
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain

compiler/defcmp.pas

@@ -29,7 +29,7 @@ interface
        cclasses,
        globtype,globals,
        node,
-       symconst,symtype,symdef;
+       symconst,symtype,symdef,symbase;
 
      type
        { if acp is cp_all the var const or nothing are considered equal }
@@ -167,6 +167,11 @@ interface
     { - objectdef: if it inherits from otherdef or they are equal              }
     function def_is_related(curdef,otherdef:tdef):boolean;
 
+    { Checks whether two defs for parameters or result types of a generic }
+    { routine can be considered as equal. Requires the symtables of the   }
+    { procdefs the parameters defs shall belong to.                       }
+    function equal_genfunc_paradefs(fwdef,currdef:tdef;fwpdst,currpdst:tsymtable):boolean;
+
 
 implementation
 
@@ -2033,23 +2038,6 @@ implementation
       var
         currpara1,
         currpara2 : tparavarsym;
-
-        function equal_genfunc_paradefs(def1,def2:tdef):boolean;
-          begin
-            result:=false;
-            if (sp_generic_para in def1.typesym.symoptions) and
-                (sp_generic_para in def2.typesym.symoptions) and
-                (def1.owner=currpara1.owner) and
-                (def2.owner=currpara2.owner) then
-              begin
-                { the forward declaration may have constraints }
-                if not (df_genconstraint in def2.defoptions) and (def2.typ=undefineddef) and
-                    ((def1.typ=undefineddef) or (df_genconstraint in def1.defoptions)) then
-                  result:=true;
-              end
-          end;
-
-      var
         eq,lowesteq : tequaltype;
         hpd       : tprocdef;
         convtype  : tconverttype;
@@ -2190,7 +2178,7 @@ implementation
                     end
                   else if (cpo_generic in cpoptions) then
                     begin
-                      if equal_genfunc_paradefs(currpara1.vardef,currpara2.vardef) then
+                      if equal_genfunc_paradefs(currpara1.vardef,currpara2.vardef,currpara1.owner,currpara2.owner) then
                         eq:=te_exact
                       else
                         exit;
@@ -2204,7 +2192,7 @@ implementation
                   if is_open_array(currpara1.vardef) and
                       is_open_array(currpara2.vardef) then
                     begin
-                      if equal_genfunc_paradefs(tarraydef(currpara1.vardef).elementdef,tarraydef(currpara2.vardef).elementdef) then
+                      if equal_genfunc_paradefs(tarraydef(currpara1.vardef).elementdef,tarraydef(currpara2.vardef).elementdef,currpara1.owner,currpara2.owner) then
                         eq:=te_exact;
                     end
                   else
@@ -2546,4 +2534,21 @@ implementation
         end;
       end;
 
+
+    function equal_genfunc_paradefs(fwdef,currdef:tdef;fwpdst,currpdst:tsymtable): boolean;
+      begin
+        result:=false;
+        { for open array parameters, typesym might not be assigned }
+        if assigned(fwdef.typesym) and (sp_generic_para in fwdef.typesym.symoptions) and
+           assigned(currdef.typesym) and (sp_generic_para in currdef.typesym.symoptions) and
+            (fwdef.owner=fwpdst) and
+            (currdef.owner=currpdst) then
+          begin
+            { the forward declaration may have constraints }
+            if not (df_genconstraint in currdef.defoptions) and (currdef.typ=undefineddef) and
+                ((fwdef.typ=undefineddef) or (df_genconstraint in fwdef.defoptions)) then
+              result:=true;
+          end
+      end;
+
 end.

compiler/ncal.pas

@@ -3530,6 +3530,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;
@@ -3539,6 +3551,7 @@ implementation
         paraidx,
         cand_cnt : integer;
         i : longint;
+        ignoregenericparacall,
         ignorevisibility,
         is_const : boolean;
         statements : tstatementnode;
@@ -3726,12 +3739,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;

compiler/nflw.pas

@@ -933,9 +933,14 @@ implementation
                         typecheckpass(expr);
                       end;
                     case expr.resultdef.typ of
-                      stringdef: result:=create_string_for_in_loop(hloopvar, hloopbody, expr);
-                      arraydef: result:=create_array_for_in_loop(hloopvar, hloopbody, expr);
-                      setdef: result:=create_set_for_in_loop(hloopvar, hloopbody, expr);
+                      stringdef:
+                        result:=create_string_for_in_loop(hloopvar, hloopbody, expr);
+                      arraydef:
+                        result:=create_array_for_in_loop(hloopvar, hloopbody, expr);
+                      setdef:
+                        result:=create_set_for_in_loop(hloopvar, hloopbody, expr);
+                      undefineddef:
+                        result:=cnothingnode.create;
                     else
                       begin
                         result:=cerrornode.create;

compiler/pdecsub.pas

@@ -535,6 +535,7 @@ implementation
         procstartfilepos : tfileposinfo;
         i,
         index : longint;
+        addgendummy,
         hadspecialize,
         firstpart,
         found,
@@ -855,6 +856,7 @@ implementation
         srsym:=nil;
         genericparams:=nil;
         hadspecialize:=false;
+        addgendummy:=false;
 
         if not assigned(genericdef) then
           begin
@@ -1059,6 +1061,7 @@ implementation
                                as if nothing happened }
                              hidesym(srsym);
                              searchagain:=true;
+                             addgendummy:=true;
                            end
                          else
                           begin
@@ -1094,6 +1097,8 @@ implementation
                   aprocsym:=cprocsym.create('$'+lower(sp))
                 else
                   aprocsym:=cprocsym.create(orgsp);
+                if addgendummy then
+                  include(aprocsym.symoptions,sp_generic_dummy);
                 symtablestack.top.insert(aprocsym);
               end;
           end;

compiler/pexpr.pas

@@ -2947,7 +2947,10 @@ implementation
                                  else
                                    begin
                                      srsym:=tprocdef(hdef).procsym;
-                                     srsymtable:=srsym.owner;
+                                     if assigned(spezcontext.symtable) then
+                                       srsymtable:=spezcontext.symtable
+                                     else
+                                       srsymtable:=srsym.owner;
                                    end;
                                end
                              else

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.

tests/webtbs/tw37844.pp

@@ -0,0 +1,40 @@
+program tw37844;
+{$mode objfpc}
+
+type
+    trec = record
+      value: longint;
+    end;
+    {generic grec<T> = record
+        value: T;
+    end;}
+
+    tmytype = class
+    public
+    generic function func1<T>( const v: longint ): trec;//specialize grec<T>;
+    end;
+
+generic function tmytype.func1<T>( const v: longint ): trec;//specialize grec<T>;
+begin
+    result.value := v;
+    //result.value := t(v);
+end;
+
+var
+    tmp: tmytype;
+    gr: trec;//specialize grec<string>;
+    vr: longint;//variant;
+
+begin
+    tmp := tmytype.Create;
+    vr := 123;
+    gr := Default(trec);
+    with tmp do
+        gr := specialize func1<string>( vr ); // <--!!!!!!!!!!!!!!!!!!!
+    //gr := tmp.specialize func1<string>(vr);
+    //writeln(gr.value);
+    tmp.Free;
+    if gr.value<>vr then
+      halt(1);
+    //readln;
+end.

tests/webtbs/tw38012.pp

@@ -0,0 +1,14 @@
+{$mode objfpc}
+
+program test;
+
+generic procedure DoThis<T>(msg: T);
+begin
+end;
+
+generic procedure DoThis<T>(a: array of T);
+begin
+end;
+
+begin
+end.

tests/webtbs/tw38058.pp

@@ -0,0 +1,71 @@
+{$mode objfpc}
+program Project1;
+type
+
+  TElem=(a,b,c,d,e,f);
+  TmyElem=(my_a,my_c,my_e);
+  TElems=set of TElem;//Output set, need convert my_a->a, my_c->c, my_e->e остальное скипаем
+  TmyElems=set of TmyElem;//Input set
+
+
+  generic TSetConverter<TGEnumIn,TGSetIn,TGEnumOut,TGSetOut,TGEnumConverter>=class
+    class function Convert(value:TGSetIn):TGSetOut;
+  end;
+
+  TmyElem2TElem_Converter=class
+    class function Convert(valueIn:TmyElem;out valueOut:TElem):boolean;
+  end;
+
+  TConverter=specialize TSetConverter<TmyElem,TmyElems,TElem,TElems,TmyElem2TElem_Converter>;
+
+  class function TmyElem2TElem_Converter.Convert(valueIn:TmyElem;out valueOut:TElem):boolean;
+  begin
+    result:=true;
+    case valueIn of
+      my_a:valueOut:=a;
+      my_c:valueOut:=c;
+      my_e:valueOut:=e;
+      else result:=false;
+    end;
+  end;
+
+  {//Variant 1
+  class function TSetConverter.Convert(value:TGSetIn):TGSetOut;
+  var
+   CurrentEnumIn:TGEnumIn;
+   CurrentEnumOut:TGEnumOut;
+   tvalue:TGSetIn;
+  begin
+    result:=[];
+    for CurrentEnumIn:=low(TGEnumIn) to high(TGEnumIn) do begin
+      tvalue:=value-[CurrentEnumIn];
+      if tvalue<>value then begin
+        if TGEnumConverter.convert(CurrentEnumIn,CurrentEnumOut) then
+          result:=result+[CurrentEnumOut];
+        if tvalue=[] then exit;
+        value:=tvalue;
+      end;
+    end;
+  end;
+  }
+  //Variant 2
+  class function TSetConverter.Convert(value:TGSetIn):TGSetOut;
+  var
+   CurrentEnumIn:TGEnumIn;
+   CurrentEnumOut:TGEnumOut;
+  begin
+    result:=[];
+    for CurrentEnumIn in value do
+        if TGEnumConverter.convert(CurrentEnumIn,CurrentEnumOut) then
+          result:=result+[CurrentEnumOut];
+  end;
+
+var
+ Elems:TElems;
+ Elem:TElem;
+begin
+  Elems:=TConverter.Convert([my_a,my_c,my_e]);
+  for Elem in Elems do
+    write(Elem);
+  readln;
+end.

tests/webtbs/tw38083.pp

@@ -0,0 +1,19 @@
+{ %NORUN }
+
+program tw38083;
+
+{$MODE Delphi}
+
+  procedure Test<T>(A: T; B: Boolean); overload;
+  begin
+
+  end;
+
+  procedure Test(A: String); overload;
+  begin
+    Test<String>(A, True);
+  end;
+
+begin
+
+end.