From c43fda1fe18f8abf3b9e9acd0fc9fe282cc7b8ef Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sun, 12 Sep 2010 16:03:00 +0000 Subject: [PATCH] * enabled maybe_call_procvar() also for macpas mode (calls procvars that don't have any parameters in most expressions, rather than using them as the procvar itself) -> replaced procvar<>nil with assigned(procvar) in test/tmacprocvar.pp to keep it compiling (otherwise it now called the procvar); necessary in combination with the next fix to compile webtbs/tw17379a.pp * automatically disambiguate the use of the function name when used as a parameter in macpas mode (if the formal parameter type is a procvar type then interpret it as the current function definition, otherwise as the current function result) (mantis #17379) git-svn-id: trunk@15971 - --- .gitattributes | 2 ++ compiler/htypechk.pas | 28 ++++++++++++++++++++++++++++ compiler/ncal.pas | 19 ++++++++++++++++++- compiler/nutils.pas | 3 +-- tests/test/tmacprocvar.pp | 2 +- tests/webtbs/tw17379.pp | 22 ++++++++++++++++++++++ tests/webtbs/tw17379a.pp | 35 +++++++++++++++++++++++++++++++++++ 7 files changed, 107 insertions(+), 4 deletions(-) create mode 100644 tests/webtbs/tw17379.pp create mode 100644 tests/webtbs/tw17379a.pp diff --git a/.gitattributes b/.gitattributes index 3355742bbc..e035bbeb8e 100644 --- a/.gitattributes +++ b/.gitattributes @@ -10649,6 +10649,8 @@ tests/webtbs/tw17337.pp svneol=native#text/plain tests/webtbs/tw17342.pp svneol=native#text/plain tests/webtbs/tw1735.pp svneol=native#text/plain tests/webtbs/tw1737.pp svneol=native#text/plain +tests/webtbs/tw17379.pp svneol=native#text/plain +tests/webtbs/tw17379a.pp svneol=native#text/plain tests/webtbs/tw1744.pp svneol=native#text/plain tests/webtbs/tw1754c.pp svneol=native#text/plain tests/webtbs/tw1755.pp svneol=native#text/plain diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 989e06ca32..4c04c8685d 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -139,6 +139,11 @@ interface { procvar handling } function is_proc2procvar_load(p:tnode;out realprocdef:tprocdef):boolean; + { returns whether a node represents a load of the function result node via + the function name (so it could also be a recursive call to the function + in case there or no parameters, or the function could be passed as + procvar } + function is_ambiguous_funcret_load(p: tnode; out owningprocdef: tprocdef): boolean; procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef); { sets varsym varstate field correctly } @@ -797,6 +802,25 @@ implementation end; + function is_ambiguous_funcret_load(p: tnode; out owningprocdef: tprocdef): boolean; + begin + result:=false; + { the funcret is an absolutevarsym, which gets converted into a type + conversion node of the loadnode of the actual function result. Its + resulttype is obviously the same as that of the real function result } + if (p.nodetype=typeconvn) and + (p.resultdef=ttypeconvnode(p).left.resultdef) then + p:=ttypeconvnode(p).left; + if (p.nodetype=loadn) and + (tloadnode(p).symtableentry.typ in [absolutevarsym,localvarsym,paravarsym]) and + ([vo_is_funcret,vo_is_result] * tabstractvarsym(tloadnode(p).symtableentry).varoptions = [vo_is_funcret]) then + begin + owningprocdef:=tprocdef(tloadnode(p).symtableentry.owner.defowner); + result:=true; + end; + end; + + { local routines can't be assigned to procvars } procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef); begin @@ -1607,6 +1631,10 @@ implementation (m_nested_procvars in current_settings.modeswitches) and is_proc2procvar_load(p.left,realprocdef) then tmpeq:=proc_to_procvar_equal(realprocdef,tprocvardef(def_to),false); + if (tmpeq=te_incompatible) and + (m_mac in current_settings.modeswitches) and + is_ambiguous_funcret_load(p.left,realprocdef) then + tmpeq:=proc_to_procvar_equal(realprocdef,tprocvardef(def_to),false); if tmpeq<>te_incompatible then eq:=tmpeq; end; diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 4b091cf936..d5b20cfa33 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -650,6 +650,7 @@ implementation block : tblocknode; statements : tstatementnode; temp : ttempcreatenode; + owningprocdef: tprocdef; begin { Be sure to have the resultdef } if not assigned(left.resultdef) then @@ -657,6 +658,22 @@ implementation if (left.nodetype<>nothingn) then begin + { convert loads of the function result variable into procvars + representing the current function in case the formal parameter is + a procvar (CodeWarrior Pascal contains the same kind of + automatic disambiguation; you can use the function name in both + meanings, so we cannot statically pick either the function result + or the function definition in pexpr) } + if (m_mac in current_settings.modeswitches) and + (parasym.vardef.typ=procvardef) and + is_ambiguous_funcret_load(left,owningprocdef) then + begin + hp:=cloadnode.create_procvar(owningprocdef.procsym,owningprocdef,owningprocdef.procsym.owner); + typecheckpass(hp); + left.free; + left:=hp; + end; + { Convert tp procvars, this is needs to be done here to make the change permanent. in the overload choosing the changes are only made temporarily } @@ -664,7 +681,7 @@ implementation not(parasym.vardef.typ in [procvardef,formaldef]) then begin if maybe_call_procvar(left,true) then - resultdef:=left.resultdef; + resultdef:=left.resultdef end; { Remove implicitly inserted typecast to pointer for diff --git a/compiler/nutils.pas b/compiler/nutils.pas index 869e0fe096..59508a1481 100644 --- a/compiler/nutils.pas +++ b/compiler/nutils.pas @@ -357,7 +357,7 @@ implementation result:=false; if (p1.resultdef.typ<>procvardef) or (tponly and - not(m_tp_procvar in current_settings.modeswitches)) then + ([m_tp_procvar,m_mac_procvar] * current_settings.modeswitches = [])) then exit; { ignore vecn,subscriptn } hp:=p1; @@ -517,7 +517,6 @@ implementation end; - function call_fail_node:tnode; var para : tcallparanode; diff --git a/tests/test/tmacprocvar.pp b/tests/test/tmacprocvar.pp index c254350225..d781df1e07 100644 --- a/tests/test/tmacprocvar.pp +++ b/tests/test/tmacprocvar.pp @@ -48,7 +48,7 @@ begin B(@A); n := nil; n := A; - if nil <> n then + if assigned(n) then C(n); C(A); C(@A); diff --git a/tests/webtbs/tw17379.pp b/tests/webtbs/tw17379.pp new file mode 100644 index 0000000000..a259e774dd --- /dev/null +++ b/tests/webtbs/tw17379.pp @@ -0,0 +1,22 @@ +{ %norun } + +{$mode macpas} +{$warnings off} +program recursivefunctionparam; + +function first( function test( theint: integer): boolean): integer; +begin {not implemented} end; + +function find: integer; + + function test( theint: integer): boolean; + begin + first( test) + end; + +begin + {not implemented} +end; + +begin +end. diff --git a/tests/webtbs/tw17379a.pp b/tests/webtbs/tw17379a.pp new file mode 100644 index 0000000000..6257354682 --- /dev/null +++ b/tests/webtbs/tw17379a.pp @@ -0,0 +1,35 @@ +{$mode macpas} + +program tmacfunret; + +var + called:boolean; + + function B(function x: integer): integer; + + begin + b:=x; + end; + + function A: Integer; + + begin + if not called then + begin + called:=true; + A:=B(A); + end + else + A:=42; + end; + +var + i: Integer; + +begin + called:=false; + i:= A; + Writeln(i); + if i <> 42 then + halt(1); +end.