From a27bc236a06f2dde0c4f8521f1ce0d3e2f75856c Mon Sep 17 00:00:00 2001 From: Sven/Sarah Barth Date: Tue, 31 May 2022 23:16:41 +0200 Subject: [PATCH] * fix #39742: when assigning a function to a function reference it's not the function itself that needs to be checked to be captureable, but instead what it captures (this applies for both the non-generic and the generic case) + added tests --- compiler/procdefutil.pas | 43 +++++++++++++++++++++++----------------- tests/test/tfuncref37.pp | 24 ++++++++++++++++++++++ tests/test/tfuncref38.pp | 24 ++++++++++++++++++++++ tests/test/tfuncref39.pp | 26 ++++++++++++++++++++++++ tests/test/tfuncref40.pp | 24 ++++++++++++++++++++++ tests/test/tfuncref41.pp | 24 ++++++++++++++++++++++ tests/test/tfuncref42.pp | 26 ++++++++++++++++++++++++ tests/webtbs/tw39742.pp | 34 +++++++++++++++++++++++++++++++ 8 files changed, 207 insertions(+), 18 deletions(-) create mode 100644 tests/test/tfuncref37.pp create mode 100644 tests/test/tfuncref38.pp create mode 100644 tests/test/tfuncref39.pp create mode 100644 tests/test/tfuncref40.pp create mode 100644 tests/test/tfuncref41.pp create mode 100644 tests/test/tfuncref42.pp create mode 100644 tests/webtbs/tw39742.pp diff --git a/compiler/procdefutil.pas b/compiler/procdefutil.pas index ce2a984a51..ce2afd0fe4 100644 --- a/compiler/procdefutil.pas +++ b/compiler/procdefutil.pas @@ -860,14 +860,6 @@ implementation result:=funcref_intf_for_proc(tabstractprocdef(n.resultdef),fileinfo_to_suffix(sym.fileinfo)); - if df_generic in owner.procdef.defoptions then - begin - { only check whether we can capture the symbol } - if not can_be_captured(sym) then - MessagePos1(n.fileinfo,sym_e_symbol_no_capture,sym.realname); - exit; - end; - if (sym.typ=procsym) and (sym.owner.symtabletype=localsymtable) then begin { this is assigning a nested function, so retrieve the correct procdef @@ -882,17 +874,29 @@ implementation if not assigned(pd) then internalerror(2022041802); end; - pinested:=find_nested_procinfo(pd); - if not assigned(pinested) then - internalerror(2022041803); - if pinested.parent<>owner then + { check whether all captured symbols can indeed be captured } + capturesyms:=pd.capturedsyms; + if assigned(capturesyms) then + for i:=0 to capturesyms.count-1 do + begin + captured:=pcapturedsyminfo(capturesyms[i]); + if not can_be_captured(captured^.sym) then + MessagePos1(captured^.fileinfo,sym_e_symbol_no_capture,captured^.sym.realname); + end; + if not (df_generic in owner.procdef.defoptions) then begin - { we need to capture this into the owner of the nested function - instead } - owner:=pinested; - capturer:=get_or_create_capturer(pinested.procdef); - if not assigned(capturer) then - internalerror(2022041804); + pinested:=find_nested_procinfo(pd); + if not assigned(pinested) then + internalerror(2022041803); + if pinested.parent<>owner then + begin + { we need to capture this into the owner of the nested function + instead } + owner:=pinested; + capturer:=get_or_create_capturer(pinested.procdef); + if not assigned(capturer) then + internalerror(2022041804); + end; end; end else if (n.resultdef.typ=procvardef) and @@ -904,6 +908,9 @@ implementation else pinested:=nil; + if df_generic in owner.procdef.defoptions then + exit; + if not assigned(capturer) then capturer:=get_or_create_capturer(owner.procdef); diff --git a/tests/test/tfuncref37.pp b/tests/test/tfuncref37.pp new file mode 100644 index 0000000000..d00075cbab --- /dev/null +++ b/tests/test/tfuncref37.pp @@ -0,0 +1,24 @@ +{ %FAIL } + +program tfuncref37; + +{$mode objfpc} +{$ModeSwitch functionreferences} + +type + TFuncRef = reference to function: LongInt; + +function Test(var aArg: LongInt): TFuncRef; + + function TestSub: LongInt; + begin + Result := aArg; + end; + +begin + Result := @TestSub; +end; + +begin +end. + diff --git a/tests/test/tfuncref38.pp b/tests/test/tfuncref38.pp new file mode 100644 index 0000000000..ba1aef08e9 --- /dev/null +++ b/tests/test/tfuncref38.pp @@ -0,0 +1,24 @@ +{ %FAIL } + +program tfuncref38; + +{$mode objfpc} +{$ModeSwitch functionreferences} + +type + TFuncRef = reference to function: LongInt; + +function Test(aArg: array of LongInt): TFuncRef; + + function TestSub: LongInt; + begin + Result := aArg[2]; + end; + +begin + Result := @TestSub; +end; + +begin +end. + diff --git a/tests/test/tfuncref39.pp b/tests/test/tfuncref39.pp new file mode 100644 index 0000000000..f54c775a3c --- /dev/null +++ b/tests/test/tfuncref39.pp @@ -0,0 +1,26 @@ +{ %FAIL } + +program tfuncref39; + +{$mode objfpc} +{$ModeSwitch functionreferences} + +type + TProcRef = reference to procedure; + +function Test: LongInt; + + procedure TestSub; + begin + Writeln(Result); + end; + +var + tmp: TProcRef; +begin + tmp := @TestSub; +end; + +begin +end. + diff --git a/tests/test/tfuncref40.pp b/tests/test/tfuncref40.pp new file mode 100644 index 0000000000..13ad5955a3 --- /dev/null +++ b/tests/test/tfuncref40.pp @@ -0,0 +1,24 @@ +{ %FAIL } + +program tfuncref40; + +{$mode objfpc} +{$ModeSwitch functionreferences} + +type + TFuncRef = reference to function: LongInt; + +generic function Test(var aArg: LongInt): TFuncRef; + + function TestSub: LongInt; + begin + Result := aArg; + end; + +begin + Result := @TestSub; +end; + +begin +end. + diff --git a/tests/test/tfuncref41.pp b/tests/test/tfuncref41.pp new file mode 100644 index 0000000000..46fd00317a --- /dev/null +++ b/tests/test/tfuncref41.pp @@ -0,0 +1,24 @@ +{ %FAIL } + +program tfuncref41; + +{$mode objfpc} +{$ModeSwitch functionreferences} + +type + TFuncRef = reference to function: LongInt; + +generic function Test(aArg: array of LongInt): TFuncRef; + + function TestSub: LongInt; + begin + Result := aArg[2]; + end; + +begin + Result := @TestSub; +end; + +begin +end. + diff --git a/tests/test/tfuncref42.pp b/tests/test/tfuncref42.pp new file mode 100644 index 0000000000..dd0edf2499 --- /dev/null +++ b/tests/test/tfuncref42.pp @@ -0,0 +1,26 @@ +{ %FAIL } + +program tfuncref39; + +{$mode objfpc} +{$ModeSwitch functionreferences} + +type + TProcRef = reference to procedure; + +generic function Test: LongInt; + + procedure TestSub; + begin + Writeln(Result); + end; + +var + tmp: TProcRef; +begin + tmp := @TestSub; +end; + +begin +end. + diff --git a/tests/webtbs/tw39742.pp b/tests/webtbs/tw39742.pp new file mode 100644 index 0000000000..d9dd412dad --- /dev/null +++ b/tests/webtbs/tw39742.pp @@ -0,0 +1,34 @@ +{ %NORUN } + +program tw39742; + +{$mode objfpc}{$H+} +{$ModeSwitch nestedprocvars} +{$ModeSwitch functionreferences} + +type + TIntFunction = reference to function: Integer; + +// Works +function FourtyTwo(const AParam: Integer): TIntFunction; +function Helper: Integer; +begin + Result := 42; +end; +begin + Result := @Helper +end; + +// Error +generic function GenericFourtyTwo: TIntFunction; +function Helper: Integer; +begin + Result := 42; +end; +begin + Result := @Helper +end; + +begin +end. +