소스 검색

* fix for Mantis #36496: correctly handle the function result alias variable inside generic functions
+ added tests

git-svn-id: trunk@43823 -

svenbarth 5 년 전
부모
커밋
3e7dc25667
6개의 변경된 파일147개의 추가작업 그리고 0개의 파일을 삭제
  1. 4 0
      .gitattributes
  2. 23 0
      compiler/pgenutil.pas
  3. 22 0
      tests/tbs/tb0666a.pp
  4. 22 0
      tests/tbs/tb0666b.pp
  5. 38 0
      tests/webtbs/tw36496a.pp
  6. 38 0
      tests/webtbs/tw36496b.pp

+ 4 - 0
.gitattributes

@@ -12992,6 +12992,8 @@ tests/tbs/tb0662.pp svneol=native#text/pascal
 tests/tbs/tb0663.pp svneol=native#text/plain
 tests/tbs/tb0664.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/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
@@ -17906,6 +17908,8 @@ 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/tw36389.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/tw3661.pp svneol=native#text/plain

+ 23 - 0
compiler/pgenutil.pas

@@ -463,6 +463,7 @@ uses
         countstr,genname,ugenname : string;
         srsym : tsym;
         st : tsymtable;
+        tmpstack : tfpobjectlist;
       begin
         context:=nil;
         result:=nil;
@@ -579,6 +580,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);

+ 22 - 0
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.

+ 22 - 0
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.

+ 38 - 0
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.
+

+ 38 - 0
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.
+