# revisions: 43566,43567,43568,43586,43629,43823

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

.gitattributes

@@ -11731,6 +11731,9 @@ tests/tbs/tb0654.pp svneol=native#text/plain
 tests/tbs/tb0655.pp svneol=native#text/pascal
 tests/tbs/tb0656.pp svneol=native#text/pascal
 tests/tbs/tb0657.pp svneol=native#text/pascal
+tests/tbs/tb0665.pp svneol=native#text/pascal
+tests/tbs/tb0666a.pp svneol=native#text/pascal
+tests/tbs/tb0666b.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
@@ -13326,6 +13329,7 @@ tests/test/tgenfunc15.pp svneol=native#text/pascal
 tests/test/tgenfunc16.pp svneol=native#text/pascal
 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/tgenfunc3.pp svneol=native#text/pascal
 tests/test/tgenfunc4.pp svneol=native#text/pascal
@@ -14063,6 +14067,7 @@ tests/test/ugeneric96b.pp svneol=native#text/pascal
 tests/test/ugeneric96c.pp svneol=native#text/pascal
 tests/test/ugeneric96d.pp svneol=native#text/pascal
 tests/test/ugeneric99.pp svneol=native#text/pascal
+tests/test/ugenfunc19.pp svneol=native#text/pascal
 tests/test/ugenfunc7.pp svneol=native#text/pascal
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhlp3.pp svneol=native#text/pascal
@@ -16484,6 +16489,9 @@ tests/webtbs/tw3619.pp svneol=native#text/plain
 tests/webtbs/tw3621.pp svneol=native#text/plain
 tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
+tests/webtbs/tw36388.pp svneol=native#text/pascal
+tests/webtbs/tw36496a.pp svneol=native#text/pascal
+tests/webtbs/tw36496b.pp svneol=native#text/pascal
 tests/webtbs/tw3650.pp svneol=native#text/plain
 tests/webtbs/tw3653.pp svneol=native#text/plain
 tests/webtbs/tw36544a.pp svneol=native#text/pascal

compiler/pgenutil.pas

@@ -464,6 +464,7 @@ uses
         countstr,genname,ugenname : string;
         srsym : tsym;
         st : tsymtable;
+        tmpstack : tfpobjectlist;
       begin
         context:=nil;
         result:=nil;
@@ -472,8 +473,21 @@ uses
         errorrecovery:=false;
         if (symname='') and
             (not assigned(genericdef) or
-            not assigned(genericdef.typesym) or
+              (
-            (genericdef.typesym.typ<>typesym)) then
+                (genericdef.typ<>procdef) and
+                (
+                  not assigned(genericdef.typesym) or
+                  (genericdef.typesym.typ<>typesym)
+                )
+              ) or
+              (
+                (genericdef.typ=procdef) and
+                (
+                  not assigned(tprocdef(genericdef).procsym) or
+                  (tprocdef(genericdef).procsym.typ<>procsym)
+                )
+              )
+            ) then
           begin
             errorrecovery:=true;
             result:=generrordef;
@@ -592,7 +606,12 @@ uses
         { use the name of the symbol as procvars return a user friendly version
           of the name }
         if symname='' then
-          genname:=ttypesym(genericdef.typesym).realname
+          begin
+            if genericdef.typ=procdef then
+              genname:=tprocdef(genericdef).procsym.realname
+            else
+              genname:=ttypesym(genericdef.typesym).realname;
+          end
         else
           genname:=symname;
 
@@ -646,6 +665,28 @@ uses
         else
           found:=searchsym(ugenname,context.sym,context.symtable);
 
+        if found and (context.sym.typ=absolutevarsym) and
+            (vo_is_funcret in tabstractvarsym(context.sym).varoptions) then
+          begin
+            { we found the function result alias of a generic function; go up the
+              symbol stack *before* this alias was inserted, so that we can
+              (hopefully) find the correct generic symbol }
+            tmpstack:=tfpobjectlist.create(false);
+            while assigned(symtablestack.top) do
+              begin
+                tmpstack.Add(symtablestack.top);
+                symtablestack.pop(symtablestack.top);
+                if tmpstack.Last=context.symtable then
+                  break;
+              end;
+            if not assigned(symtablestack.top) then
+              internalerror(2019123001);
+            found:=searchsym(ugenname,context.sym,context.symtable);
+            for i:=tmpstack.count-1 downto 0 do
+              symtablestack.push(tsymtable(tmpstack[i]));
+            tmpstack.free;
+          end;
+
         if not found or not (context.sym.typ in [typesym,procsym]) then
           begin
             identifier_not_found(genname);
@@ -735,6 +776,7 @@ uses
         old_current_specializedef,
         old_current_genericdef : tstoreddef;
         old_current_procinfo : tprocinfo;
+        old_module_procinfo : tobject;
         hmodule : tmodule;
         oldcurrent_filepos : tfileposinfo;
         recordbuf : tdynamicarray;
@@ -859,7 +901,13 @@ uses
         { decide in which symtable to put the specialization }
         if parse_generic and not assigned(result) then
           begin
-            if assigned(current_procinfo) and (df_generic in current_procinfo.procdef.defoptions) then
+            srsymtable:=symtablestack.top;
+            if (srsymtable.symtabletype in [localsymtable,parasymtable]) and tstoreddef(srsymtable.defowner).is_specialization then
+              { if we are currently specializing a routine we need to specialize into
+                the routine's local- or parasymtable so that they are correctly
+                registered should the specialization be finalized }
+              specializest:=srsymtable
+            else if assigned(current_procinfo) and (df_generic in current_procinfo.procdef.defoptions) then
               { if we are parsing the definition of a method we specialize into
                 the local symtable of it }
               specializest:=current_procinfo.procdef.getsymtable(gs_local)
@@ -943,8 +991,10 @@ uses
                 old_current_genericdef:=nil;
                 old_current_structdef:=nil;
                 old_current_procinfo:=current_procinfo;
+                old_module_procinfo:=current_module.procinfo;
 
                 current_procinfo:=nil;
+                current_module.procinfo:=nil;
 
                 if parse_class_parent then
                   begin
@@ -1126,6 +1176,7 @@ uses
 
                 block_type:=old_block_type;
                 current_procinfo:=old_current_procinfo;
+                current_module.procinfo:=old_module_procinfo;
                 if parse_class_parent then
                   begin
                     current_structdef:=old_current_structdef;

compiler/symbase.pas

@@ -283,6 +283,10 @@ implementation
         while assigned(st.defowner) do
           begin
             st:=st.defowner.owner;
+            { this can happen for specializations of routines that are not yet
+              owned cause they might be thrown away again }
+            if not assigned(st) then
+              break;
             { the flag is already set, so by definition it is set in the
               owning symtables as well }
             if option in st.tableoptions then

compiler/symtable.pas

@@ -4119,6 +4119,16 @@ implementation
           anything }
         if current_module.extendeddefs.count=0 then
           exit;
+        if (df_genconstraint in pd.defoptions) then
+          begin
+            { if we have a constraint for a class type or a single interface we
+              use that to resolve helpers at declaration time of the generic,
+              otherwise there can't be any helpers as the type isn't known yet }
+            if pd.typ=objectdef then
+              pd:=tobjectdef(pd).getparentdef
+            else
+              exit;
+          end;
         { no helpers for anonymous types }
         if ((pd.typ in [recorddef,objectdef]) and
             (

tests/tbs/tb0665.pp

@@ -0,0 +1,33 @@
+program tb0665;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+    b: Boolean;
+    function Test(aArg: Pointer): Boolean; inline;
+    generic function Test<T>: Boolean; inline;
+  end;
+
+function TTest.Test(aArg: Pointer): Boolean;
+begin
+  b := True;
+  Result := True;
+end;
+
+generic function TTest.Test<T>: Boolean;
+begin
+  Result := Test(Nil);
+end;
+
+var
+  t: TTest;
+begin
+  t.b := False;
+  { check for side effects to ensure that the code was correctly generated }
+  t.specialize Test<LongInt>;
+  if not t.b then
+    Halt(1);
+  Writeln('ok');
+end.

tests/tbs/tb0666a.pp

@@ -0,0 +1,22 @@
+{ %NORUN }
+
+program tb0666a;
+
+{$mode delphi}
+
+function Test<T>: T;
+
+  procedure Foo;
+  begin
+    Test<T>;
+    Test<LongInt>;
+    Test<String>;
+  end;
+
+begin
+  Foo;
+end;
+
+begin
+  Test<LongInt>;
+end.

tests/tbs/tb0666b.pp

@@ -0,0 +1,22 @@
+{ %NORUN }
+
+program tb0666b;
+
+{$mode objfpc}
+
+generic function Test<T>: T;
+
+  procedure Foo;
+  begin
+    specialize Test<T>;
+    specialize Test<LongInt>;
+    specialize Test<String>;
+  end;
+
+begin
+  Foo;
+end;
+
+begin
+  specialize Test<LongInt>;
+end.

tests/test/tgenfunc19.pp

@@ -0,0 +1,33 @@
+program tgenfunc19;
+
+{$mode objfpc}
+
+uses
+  ugenfunc19;
+
+type
+  TTest2 = class(TTest)
+    class function Test: LongInt;
+  end;
+
+  TTest2Helper = class helper for TTest2
+    class function Test: LongInt;
+  end;
+
+class function TTest2.Test: LongInt;
+begin
+  Result := 3;
+end;
+
+class function TTest2Helper.Test: LongInt;
+begin
+  Result := 4;
+end;
+
+begin
+  if specialize DoTest<TTest> <> 2 then
+    Halt(1);
+  if specialize DoTest<TTest2> <> 3 then
+    Halt(2);
+  Writeln('Ok');
+end.

tests/test/ugenfunc19.pp

@@ -0,0 +1,37 @@
+unit ugenfunc19;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  TTest = class
+    class function Test: LongInt; static;
+  end;
+
+  TTestHelper = class helper for TTest
+    class function Test: LongInt; static;
+  end;
+
+generic function DoTest<T: TTest>: LongInt;
+
+implementation
+
+class function TTest.Test: LongInt;
+begin
+  Result := 1;
+end;
+
+class function TTestHelper.Test: LongInt;
+begin
+  Result := 2;
+end;
+
+generic function DoTest<T>: LongInt;
+begin
+  Result := T.Test;
+end;
+
+
+end.
+

tests/webtbs/tw36388.pp

@@ -0,0 +1,16 @@
+{ %NORUN }
+
+{$mode objfpc}
+
+program tw36388;
+uses
+  SysUtils, FGL;
+
+generic function CopyList<T: TFPSList> (source: T): T;
+begin
+ // Internal error 200204175
+  result := T.Create;
+end;
+
+begin
+end.

tests/webtbs/tw36496a.pp

@@ -0,0 +1,38 @@
+{ %NORUN }
+
+(*
+  testing application for
+  https://forum.lazarus.freepascal.org/index.php/topic,47936.0.html
+*)
+program tw36496a;
+
+{$Mode delphi}
+
+function TestGenRecurse<T>(const AInput : T) : Boolean;
+begin
+  //Result := False;
+
+  (*
+    below, if uncommented will fail to compile
+    tester.lpr(12,19) Error: Identifier not found "TestGenRecurse$1"
+  *)
+  TestGenRecurse<T>(AInput);
+  TestGenRecurse<String>('test');
+  TestGenRecurse<LongInt>(42);
+end;
+
+procedure TestGenRecurseProc<T>(const AInput : T);
+begin
+  (*
+    below method calls compile fine
+  *)
+  TestGenRecurseProc<T>(AInput);
+  TestGenRecurseProc<String>('test');
+  TestGenRecurseProc<LongInt>(42);
+end;
+
+begin
+  TestGenRecurse<String>('testing');
+  TestGenRecurseProc<String>('testing');
+end.
+

tests/webtbs/tw36496b.pp

@@ -0,0 +1,38 @@
+{ %NORUN }
+
+(*
+  testing application for
+  https://forum.lazarus.freepascal.org/index.php/topic,47936.0.html
+*)
+program tw36496b;
+
+{$Mode objfpc}{$H+}
+
+generic function TestGenRecurse<T>(const AInput : T) : Boolean;
+begin
+  //Result := False;
+
+  (*
+    below, if uncommented will fail to compile
+    tester.lpr(12,19) Error: Identifier not found "TestGenRecurse$1"
+  *)
+  specialize TestGenRecurse<T>(AInput);
+  specialize TestGenRecurse<String>('test');
+  specialize TestGenRecurse<LongInt>(42);
+end;
+
+generic procedure TestGenRecurseProc<T>(const AInput : T);
+begin
+  (*
+    below method calls compile fine
+  *)
+  specialize TestGenRecurseProc<T>(AInput);
+  specialize TestGenRecurseProc<String>('test');
+  specialize TestGenRecurseProc<LongInt>(42);
+end;
+
+begin
+  specialize TestGenRecurse<String>('testing');
+  specialize TestGenRecurseProc<String>('testing');
+end.
+