* the never ending story of tp procvar hacks

compiler/defcmp.pas

@@ -195,17 +195,6 @@ implementation
             exit;
           end;
 
-         { tp7 procvar def support, in tp7 a procvar is always called, if the
-           procvar is passed explicit a addrn would be there }
-         if (m_tp_procvar in aktmodeswitches) and
-            (def_from.deftype=procvardef) and
-            (fromtreetype=loadn) and
-            { only if the procvar doesn't require any paramters }
-            (tprocvardef(def_from).minparacount = 0) then
-          begin
-            def_from:=tprocvardef(def_from).rettype.def;
-          end;
-
          { we walk the wanted (def_to) types and check then the def_from
            types if there is a conversion possible }
          b:=te_incompatible;
@@ -1160,7 +1149,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2002-11-27 02:32:14  peter
+  Revision 1.3  2002-11-27 15:33:46  peter
+    * the never ending story of tp procvar hacks
+
+  Revision 1.2  2002/11/27 02:32:14  peter
     * fix cp_procvar compare
 
   Revision 1.1  2002/11/25 17:43:16  peter

compiler/ncal.pas

@@ -526,15 +526,7 @@ type
              if (m_tp_procvar in aktmodeswitches) and
                 (left.nodetype=calln) and
                 (is_void(left.resulttype.def)) then
-              begin
-                p1:=cloadnode.create_procvar(tcallnode(left).symtableprocentry,
-                   tprocdef(tcallnode(left).procdefinition),tcallnode(left).symtableproc);
-                if assigned(tcallnode(left).right) then
-                 tloadnode(p1).set_mp(tcallnode(left).right);
-                left.free;
-                left:=p1;
-                resulttypepass(left);
-              end;
+               load_procvar_from_calln(left);
 
              case defcoll.paratyp of
                vs_var,
@@ -1618,6 +1610,7 @@ type
         found,
         is_const : boolean;
         bestord  : torddef;
+        eq : tequaltype;
         srprocsym  : tprocsym;
         srsymtable : tsymtable;
       begin
@@ -1884,14 +1877,19 @@ type
                                     hp^.nextPara.convertlevel:=0
                                    else
                                     begin
-                                      case compare_defs(pt.resulttype.def,hp^.nextPara.paratype.def,pt.left.nodetype) of
+                                      eq:=compare_defs(pt.resulttype.def,hp^.nextPara.paratype.def,pt.left.nodetype);
+                                      case eq of
+                                        te_equal,
+                                        te_exact,
                                         te_convert_l1 :
                                           hp^.nextPara.convertlevel:=1;
                                         te_convert_operator,
                                         te_convert_l2 :
                                           hp^.nextPara.convertlevel:=2;
-                                        else
+                                        te_incompatible :
                                           hp^.nextPara.convertlevel:=0;
+                                        else
+                                          internalerror(200211271);
                                       end;
                                     end;
                                    case hp^.nextPara.convertlevel of
@@ -2844,7 +2842,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.111  2002-11-27 02:31:17  peter
+  Revision 1.112  2002-11-27 15:33:46  peter
+    * the never ending story of tp procvar hacks
+
+  Revision 1.111  2002/11/27 02:31:17  peter
     * fixed inlinetree parsing in det_resulttype
 
   Revision 1.110  2002/11/25 18:43:32  carl

compiler/ninl.pas

@@ -1096,7 +1096,7 @@ implementation
       var
          vl,vl2    : TConstExprInt;
          vr        : bestreal;
-         hp        : tnode;
+         hp,p1     : tnode;
          srsym     : tsym;
          isreal    : boolean;
          checkrange : boolean;
@@ -1569,13 +1569,7 @@ implementation
 
               in_assigned_x:
                 begin
-{
-                   result := caddnode.create(unequaln,
-                     ctypeconvnode.create_explicit(tcallparanode(left).left,
-                     voidpointertype),cnilnode.create);
-}
-                   result := caddnode.create(unequaln,tcallparanode(left).left,
-                     cnilnode.create);
+                   result := caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create);
                    tcallparanode(left).left := nil;
                    { free left, because otherwise some code at 'myexit' tries  }
                    { to run get_paratype for it, which crashes since left.left }
@@ -2401,7 +2395,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.99  2002-11-27 02:37:13  peter
+  Revision 1.100  2002-11-27 15:33:47  peter
+    * the never ending story of tp procvar hacks
+
+  Revision 1.99  2002/11/27 02:37:13  peter
     * case statement inlining added
     * fixed inlining of write()
     * switched statementnode left and right parts so the statements are

compiler/nld.pas

@@ -147,6 +147,8 @@ interface
        crttinode : trttinodeclass;
 
 
+      procedure load_procvar_from_calln(var p1:tnode);
+
 implementation
 
     uses
@@ -156,6 +158,36 @@ implementation
       ncon,ninl,ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
       ;
 
+{*****************************************************************************
+                                 Helpers
+*****************************************************************************}
+
+      procedure load_procvar_from_calln(var p1:tnode);
+        var
+          p2 : tnode;
+        begin
+          { was it a procvar, then we simply remove the calln and
+            reuse the right }
+          if assigned(tcallnode(p1).right) then
+            begin
+              p2:=tcallnode(p1).right;
+              tcallnode(p1).right:=nil;
+            end
+          else
+            begin
+              p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry,
+                 tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc);
+              if assigned(tcallnode(p1).methodpointer) then
+               begin
+                 tloadnode(p2).set_mp(tcallnode(p1).methodpointer);
+                 tcallnode(p1).methodpointer:=nil;
+               end;
+            end;
+          resulttypepass(p2);
+          p1.free;
+          p1:=p2;
+        end;
+
 
 {*****************************************************************************
                              TLOADNODE
@@ -1181,7 +1213,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.66  2002-11-25 17:43:20  peter
+  Revision 1.67  2002-11-27 15:33:47  peter
+    * the never ending story of tp procvar hacks
+
+  Revision 1.66  2002/11/25 17:43:20  peter
     * splitted defbase in defutil,symutil,defcmp
     * merged isconvertable and is_equal into compare_defs(_ext)
     * made operator search faster by walking the list only once

compiler/pexpr.pas

@@ -207,8 +207,8 @@ implementation
          p1 : tnode;
       begin
          if (m_tp_procvar in aktmodeswitches) and
+            (token<>_ASSIGNMENT) and
             (not got_addrn) and
-            (not in_args) and
             (block_type=bt_general) then
           begin
             { ignore vecn,subscriptn }
@@ -225,9 +225,16 @@ implementation
             until false;
             if (hp.nodetype=loadn) then
                begin
-                  { support if procvar then for tp7 and many other expression like this }
+                  { get the resulttype of p }
                   do_resulttypepass(p);
-                  if (getprocvardef=nil) and (p.resulttype.def.deftype=procvardef) then
+                  { convert the procvar load to a call:
+                     - not expecting a procvar
+                     - the procvar does not get arguments, when it
+                       requires arguments the callnode will fail
+                       Note: When arguments were passed there was no loadn }
+                  if (getprocvardef=nil) and
+                     (p.resulttype.def.deftype=procvardef) and
+                     (tprocvardef(p.resulttype.def).minparacount=0) then
                     begin
                        p1:=ccallnode.create(nil,nil,nil,nil);
                        tcallnode(p1).set_procvar(p);
@@ -362,6 +369,12 @@ implementation
               p1:=comp_expr(true);
               if not codegenerror then
                begin
+                 { load procvar if a procedure is passed }
+                 if (m_tp_procvar in aktmodeswitches) and
+                    (p1.nodetype=calln) and
+                    (is_void(p1.resulttype.def)) then
+                   load_procvar_from_calln(p1);
+
                  case p1.resulttype.def.deftype of
                    pointerdef,
                    procvardef,
@@ -1616,13 +1629,12 @@ implementation
                                 p2:=p1;
                                 p1:=ccallnode.create(nil,nil,nil,nil);
                                 tcallnode(p1).set_procvar(p2);
-                                if token=_LKLAMMER then
+                                if try_to_consume(_LKLAMMER) then
                                   begin
-                                     consume(_LKLAMMER);
                                      tcallnode(p1).left:=parse_paras(false,false);
                                      consume(_RKLAMMER);
                                   end;
-                             { proc():= is never possible }
+                                { proc():= is never possible }
                                 if token=_ASSIGNMENT then
                                  begin
                                    Message(cg_e_illegal_expression);
@@ -2021,9 +2033,7 @@ implementation
 
         { tp7 procvar handling, but not if the next token
           will be a := }
-        if (m_tp_procvar in aktmodeswitches) and
-           (token<>_ASSIGNMENT) then
-          check_tp_procvar(p1);
+        check_tp_procvar(p1);
 
         factor:=p1;
         check_tokenpos;
@@ -2160,9 +2170,7 @@ implementation
          if not assigned(p1.resulttype.def) then
           do_resulttypepass(p1);
          filepos:=akttokenpos;
-         if (m_tp_procvar in aktmodeswitches) and
-            (token<>_ASSIGNMENT) then
-           check_tp_procvar(p1);
+         check_tp_procvar(p1);
          if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
            afterassignment:=true;
          oldp1:=p1;
@@ -2264,7 +2272,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.93  2002-11-26 22:58:24  peter
+  Revision 1.94  2002-11-27 15:33:47  peter
+    * the never ending story of tp procvar hacks
+
+  Revision 1.93  2002/11/26 22:58:24  peter
     * fix for tw2178. When a ^ or . follows a procsym then the procsym
       needs to be called