paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 14:09:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* don't insert anonymous functions into a withsymtable

Browse Source 
+ added test
This commit is contained in:
Sven/Sarah Barth 2023-06-23 17:02:15 +02:00 committed by Pierre Muller
parent 2eac11a8ab
commit d40437901e
2 changed files with 52 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
compiler/pdecsub.pas
View File

@ -545,6 +545,7 @@ implementation
found,
searchagain : boolean;
st,
insertst,
genericst: TSymtable;
aprocsym : tprocsym;
popclass : integer;
@ -854,19 +855,23 @@ implementation
hadspecialize:=false;
addgendummy:=false;
{ ensure that we don't insert into a withsymtable (can happen with
anonymous functions) }
checkstack:=symtablestack.stack;
while checkstack^.symtable.symtabletype in [withsymtable] do
checkstack:=checkstack^.next;
insertst:=checkstack^.symtable;
if not assigned(genericdef) then
begin
if ppf_anonymous in flags then
begin
checkstack:=symtablestack.stack;
while checkstack^.symtable.symtabletype in [withsymtable] do
checkstack:=checkstack^.next;
if not (checkstack^.symtable.symtabletype in [localsymtable,staticsymtable]) then
if not (insertst.symtabletype in [localsymtable,staticsymtable]) then
internalerror(2021050101);
{ generate a unique name for the anonymous function; don't use
something like file position however as this might be inside
an include file that's included multiple times }
str(checkstack^.symtable.symlist.count,orgsp);
str(insertst.symlist.count,orgsp);
orgsp:='__FPCINTERNAL__Anonymous_'+orgsp;
sp:=upper(orgsp);
spnongen:=sp;
@ -1032,7 +1037,7 @@ implementation
if (potype=potype_operator)and(optoken=NOTOKEN) then
parse_operator_name;
srsym:=tsym(symtablestack.top.Find(sp));
srsym:=tsym(insertst.Find(sp));
{ Also look in the globalsymtable if we didn't found
the symbol in the localsymtable }
@ -1102,7 +1107,7 @@ implementation
operation }
if (potype=potype_operator) then
begin
aprocsym:=Tprocsym(symtablestack.top.Find(sp));
aprocsym:=Tprocsym(insertst.Find(sp));
if aprocsym=nil then
aprocsym:=cprocsym.create('$'+sp);
end
@ -1115,7 +1120,7 @@ implementation
include(aprocsym.symoptions,sp_internal);
if addgendummy then
include(aprocsym.symoptions,sp_generic_dummy);
symtablestack.top.insertsym(aprocsym);
insertst.insertsym(aprocsym);
end;
end;
@ -1176,7 +1181,7 @@ implementation
dummysym:=tsym(astruct.symtable.find(spnongen))
else
begin
dummysym:=tsym(symtablestack.top.find(spnongen));
dummysym:=tsym(insertst.find(spnongen));
if not assigned(dummysym) and
(symtablestack.top=current_module.localsymtable) and
assigned(current_module.globalsymtable) then
@ -1190,7 +1195,7 @@ implementation
if assigned(astruct) then
astruct.symtable.insertsym(dummysym)
else
symtablestack.top.insertsym(dummysym);
insertst.insertsym(dummysym);
end
else if (dummysym.typ<>procsym) and
(
@ -1282,8 +1287,8 @@ implementation
{ symbol options that need to be kept per procdef }
pd.fileinfo:=procstartfilepos;
pd.visibility:=symtablestack.top.currentvisibility;
if symtablestack.top.currentlyoptional then
pd.visibility:=insertst.currentvisibility;
if insertst.currentlyoptional then
include(pd.procoptions,po_optional);
{ parse parameters }

35
tests/test/tanonfunc73.pp Normal file
View File

@ -0,0 +1,35 @@
{ %NORUN }
program tanonfunc73;
{$mode objfpc}
{$modeswitch anonymousfunctions}
{$modeswitch functionreferences}
type
TProc = reference to procedure;
procedure Test;
var
o: TObject;
p: TProc;
begin
with o do begin
p := procedure
begin
Writeln('Hello World');
end;
end;
end;
var
o: TObject;
p: TProc;
begin
with o do begin
p := procedure
begin
Writeln('Hello World');
end;
end;
end.