* fixed procedure<>procedure construct

compiler/cg386cal.pas

@@ -1889,6 +1889,9 @@ implementation
                       r,p^.location.register)));
                     exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,
                       p^.location.register)));
+                    if parraydef(p^.left^.resulttype)^.elesize<>1 then
+                      exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,
+                        parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
                   end
                  else
                   begin
@@ -2311,7 +2314,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  1998-08-11 14:05:33  peter
+  Revision 1.15  1998-08-13 11:00:09  peter
+    * fixed procedure<>procedure construct
+
+  Revision 1.14  1998/08/11 14:05:33  peter
     * fixed sizeof(array of char)
 
   Revision 1.13  1998/08/10 14:49:45  peter

compiler/pass_1.pas

@@ -1617,6 +1617,7 @@ unit pass_1;
          hp  : ptree;
          hp2 : pdefcoll;
          store_valid : boolean;
+         hp3 : pabstractprocdef;
 
       begin
          make_not_regable(p^.left);
@@ -1632,13 +1633,16 @@ unit pass_1;
                      begin
                         p^.resulttype:=new(pprocvardef,init);
 
-                        pprocvardef(p^.resulttype)^.options:=
-                          p^.left^.symtableprocentry^.definition^.options;
+                     { it could also be a procvar, not only pprocsym ! }
+                        if p^.left^.symtableprocentry^.typ=varsym then
+                         hp3:=pabstractprocdef(pvarsym(p^.left^.symtableprocentry)^.definition)
+                        else
+                         hp3:=pabstractprocdef(pprocsym(p^.left^.symtableprocentry)^.definition);
 
-                        pprocvardef(p^.resulttype)^.retdef:=
-                          p^.left^.symtableprocentry^.definition^.retdef;
+                        pprocvardef(p^.resulttype)^.options:=hp3^.options;
+                        pprocvardef(p^.resulttype)^.retdef:=hp3^.retdef;
 
-                        hp2:=p^.left^.symtableprocentry^.definition^.para1;
+                        hp2:=hp3^.para1;
                         while assigned(hp2) do
                           begin
                              pprocvardef(p^.resulttype)^.concatdef(hp2^.data,hp2^.paratyp);
@@ -2997,7 +3001,7 @@ unit pass_1;
               { do we know the procedure to call ? }
               if not(assigned(p^.procdefinition)) then
                 begin
-                   actprocsym:=p^.symtableprocentry;
+                   actprocsym:=pprocsym(p^.symtableprocentry);
                    { determine length of parameter list }
                    pt:=p^.left;
                    paralength:=0;
@@ -5179,7 +5183,10 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.53  1998-08-12 19:39:28  peter
+  Revision 1.54  1998-08-13 11:00:10  peter
+    * fixed procedure<>procedure construct
+
+  Revision 1.53  1998/08/12 19:39:28  peter
     * fixed some crashes
 
   Revision 1.52  1998/08/10 14:50:08  peter

compiler/pexpr.pas

@@ -1,4 +1,4 @@
- {
+{
     $Id$
     Copyright (c) 1998 by Florian Klaempfl
 
@@ -868,15 +868,17 @@ unit pexpr;
                              else
                              if (token=LKLAMMER) or
                                 ((pprocvardef(pd)^.para1=nil) and
-                                (token<>ASSIGNMENT) and (not in_args)) then
+                                 (not((token in [ASSIGNMENT,UNEQUAL,EQUAL]))) and
+                                 (not afterassignment) and
+                                 (not in_args)) then
                                begin
                                   { do this in a strange way  }
                                   { it's not a clean solution }
                                   p2:=p1;
-                                  p1:=gencallnode(nil,
-                                    nil);
+                                  p1:=gencallnode(nil,nil);
                                   p1^.right:=p2;
                                   p1^.unit_specific:=unit_specific;
+                                  p1^.symtableprocentry:=sym;
                                   if token=LKLAMMER then
                                     begin
                                        consume(LKLAMMER);
@@ -884,9 +886,17 @@ unit pexpr;
                                        consume(RKLAMMER);
                                     end;
                                   pd:=pprocvardef(pd)^.retdef;
+                               { proc():= is never possible }
+                                  if token in [ASSIGNMENT,UNEQUAL,EQUAL] then
+                                   begin
+                                     Message(cg_e_illegal_expression);
+                                     p1:=genzeronode(errorn);
+                                     again:=false;
+                                   end;
                                   p1^.resulttype:=pd;
                                end
-                             else again:=false;
+                             else
+                              again:=false;
                              p1^.resulttype:=pd;
                           end
                           else again:=false;
@@ -1740,53 +1750,55 @@ unit pexpr;
          expr:=p1;
       end;
 
-    function get_intconst:longint;
 
+    function get_intconst:longint;
     {Reads an expression, tries to evalute it and check if it is an integer
      constant. Then the constant is returned.}
-
-    var p:Ptree;
-
+    var
+      p:Ptree;
     begin
-        p:=comp_expr(true);
-        do_firstpass(p);
-        if (p^.treetype<>ordconstn) and
+      p:=comp_expr(true);
+      do_firstpass(p);
+      if (p^.treetype<>ordconstn) and
          (p^.resulttype^.deftype=orddef) and
-         not (Porddef(p^.resulttype)^.typ in
-         [uvoid,uchar,bool8bit]) then
-            Message(cg_e_illegal_expression)
-        else
-            get_intconst:=p^.value;
-        disposetree(p);
+         not(Porddef(p^.resulttype)^.typ in [uvoid,uchar,bool8bit,bool16bit,bool32bit]) then
+        Message(cg_e_illegal_expression)
+      else
+        get_intconst:=p^.value;
+      disposetree(p);
     end;
 
-    function get_stringconst:string;
 
+    function get_stringconst:string;
     {Reads an expression, tries to evaluate it and checks if it is a string
      constant. Then the constant is returned.}
-
-    var p:Ptree;
-
+    var
+      p:Ptree;
     begin
-        get_stringconst:='';
-        p:=comp_expr(true);
-        do_firstpass(p);
-        if p^.treetype<>stringconstn then
-            if (p^.treetype=ordconstn) and
+      get_stringconst:='';
+      p:=comp_expr(true);
+      do_firstpass(p);
+      if p^.treetype<>stringconstn then
+        begin
+          if (p^.treetype=ordconstn) and
              (p^.resulttype^.deftype=orddef) and
              (Porddef(p^.resulttype)^.typ=uchar) then
-                get_stringconst:=char(p^.value)
-            else
-                Message(cg_e_illegal_expression)
-        else
-            get_stringconst:=p^.values^;
-        disposetree(p);
+            get_stringconst:=char(p^.value)
+          else
+            Message(cg_e_illegal_expression);
+        end
+      else
+        get_stringconst:=p^.values^;
+      disposetree(p);
     end;
 
 end.
 {
   $Log$
-  Revision 1.33  1998-08-11 15:31:39  peter
+  Revision 1.34  1998-08-13 11:00:12  peter
+    * fixed procedure<>procedure construct
+
+  Revision 1.33  1998/08/11 15:31:39  peter
     * write extended to ppu file
     * new version 0.99.7
 
@@ -1832,8 +1844,6 @@ end.
   Revision 1.23  1998/06/04 09:55:40  pierre
     * demangled name of procsym reworked to become independant of the mangling scheme
 
-  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
-
   Revision 1.22  1998/06/02 17:03:03  pierre
     *  with node corrected for objects
     * small bugs for SUPPORT_MMX fixed

compiler/tree.pas

@@ -204,7 +204,7 @@ unit tree;
              assignn : (assigntyp : tassigntyp;concat_string : boolean);
              loadn : (symtableentry : psym;symtable : psymtable;
                       is_absolute,is_first : boolean);
-             calln : (symtableprocentry : pprocsym;
+             calln : (symtableprocentry : psym;
                       symtableproc : psymtable;procdefinition : pprocdef;
                       methodpointer : ptree;
                       no_check,unit_specific,return_value_used : boolean);
@@ -1557,7 +1557,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.27  1998-08-10 14:50:35  peter
+  Revision 1.28  1998-08-13 11:00:13  peter
+    * fixed procedure<>procedure construct
+
+  Revision 1.27  1998/08/10 14:50:35  peter
     + localswitches, moduleswitches, globalswitches splitting
 
   Revision 1.26  1998/08/10 09:57:19  peter