* 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

@@ -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

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;

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

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;

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);

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.

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.