mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-19 18:51:31 +02:00
* fix for Mantis #36496: correctly handle the function result alias variable inside generic functions
+ added tests git-svn-id: trunk@43823 -
This commit is contained in:
parent
6fc79c7ed0
commit
3e7dc25667
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -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
|
||||
|
@ -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
tests/tbs/tb0666a.pp
Normal file
22
tests/tbs/tb0666a.pp
Normal file
@ -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
tests/tbs/tb0666b.pp
Normal file
22
tests/tbs/tb0666b.pp
Normal file
@ -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
tests/webtbs/tw36496a.pp
Normal file
38
tests/webtbs/tw36496a.pp
Normal file
@ -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
tests/webtbs/tw36496b.pp
Normal file
38
tests/webtbs/tw36496b.pp
Normal file
@ -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.
|
||||
|
Loading…
Reference in New Issue
Block a user