* merged from 0_99_12 branch

compiler/cgai386.pas

@@ -2801,8 +2801,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
   begin
       if procinfo.retdef<>pdef(voiddef) then
           begin
-              if (procinfo.flags and pi_operator)<>0 then
-                procinfo.funcret_is_valid:=opsym^.refs>0;
+              if ((procinfo.flags and pi_operator)<>0) and
+                 assigned(opsym) then
+                procinfo.funcret_is_valid:=
+                  procinfo.funcret_is_valid or (opsym^.refs>0);
               if not(procinfo.funcret_is_valid) and not inlined { and
                 ((procinfo.flags and pi_uses_asm)=0)} then
                CGMessage(sym_w_function_result_not_set);
@@ -3086,7 +3088,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.6  1999-06-14 17:47:48  peter
+  Revision 1.7  1999-06-17 13:19:50  pierre
+   * merged from 0_99_12 branch
+
+  Revision 1.5.2.2  1999/06/17 12:38:39  pierre
+   * wrong warning for operators removed
+
+  Revision 1.6  1999/06/14 17:47:48  peter
     * merged
 
   Revision 1.5.2.1  1999/06/14 17:27:08  peter

compiler/htypechk.pas

@@ -50,7 +50,7 @@ interface
     function  valid_for_formal_const(p : ptree) : boolean;
     function  is_procsym_load(p:Ptree):boolean;
     function  is_procsym_call(p:Ptree):boolean;
-    function  is_assignment_overloaded(from_def,to_def : pdef) : boolean;
+    function  assignment_overloaded(from_def,to_def : pdef) : pprocdef;
 
 
 implementation
@@ -460,7 +460,7 @@ implementation
            else
              begin
              { assignment overwritten ?? }
-               if is_assignment_overloaded(def_from,def_to) then
+               if assigned(assignment_overloaded(def_from,def_to)) then
                 b:=2;
              end;
          end;
@@ -636,12 +636,12 @@ implementation
       end;
 
 
-    function is_assignment_overloaded(from_def,to_def : pdef) : boolean;
+    function assignment_overloaded(from_def,to_def : pdef) : pprocdef;
        var
           passproc : pprocdef;
           convtyp : tconverttype;
        begin
-          is_assignment_overloaded:=false;
+          assignment_overloaded:=nil;
           if assigned(overloaded_operators[assignment]) then
             passproc:=overloaded_operators[assignment]^.definition
           else
@@ -649,9 +649,10 @@ implementation
           while passproc<>nil do
             begin
               if is_equal(passproc^.retdef,to_def) and
-                 (isconvertable(from_def,passproc^.para1^.data,convtyp,ordconstn,false)=1) then
+                 (is_equal(passproc^.para1^.data,from_def) or
+                 (isconvertable(from_def,passproc^.para1^.data,convtyp,ordconstn,false)=1)) then
                 begin
-                   is_assignment_overloaded:=true;
+                   assignment_overloaded:=passproc;
                    break;
                 end;
               passproc:=passproc^.nextoverloaded;
@@ -661,7 +662,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  1999-06-01 19:27:47  peter
+  Revision 1.28  1999-06-17 13:19:51  pierre
+   * merged from 0_99_12 branch
+
+  Revision 1.27.2.1  1999/06/17 12:51:42  pierre
+   * changed is_assignment_overloaded into
+      function assignment_overloaded : pprocdef
+      to allow overloading of assignment with only different result type
+
+  Revision 1.27  1999/06/01 19:27:47  peter
     * better checks for procvar and methodpointer
 
   Revision 1.26  1999/05/20 14:58:26  peter

compiler/pexpr.pas

@@ -838,6 +838,9 @@ unit pexpr;
                   (not ((m_tp in aktmodeswitches) and
                   (afterassignment or in_args))) then
                  begin
+                    if ((pvarsym(sym)=opsym) and
+                       ((p^.flags and pi_operator)<>0)) then
+                       inc(opsym^.refs);
                     p1:=genzeronode(funcretn);
                     pd:=p^.retdef;
                     p1^.funcretprocinfo:=p;
@@ -2024,7 +2027,15 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.114  1999-06-15 18:58:33  peter
+  Revision 1.115  1999-06-17 13:19:52  pierre
+   * merged from 0_99_12 branch
+
+  Revision 1.112.2.3  1999/06/17 12:51:44  pierre
+   * changed is_assignment_overloaded into
+      function assignment_overloaded : pprocdef
+      to allow overloading of assignment with only different result type
+
+  Revision 1.114  1999/06/15 18:58:33  peter
     * merged
 
   Revision 1.113  1999/06/13 22:41:05  peter

compiler/pstatmnt.pas

@@ -1158,7 +1158,8 @@ unit pstatmnt;
                 begin
                    { the space has been set in the local symtable }
                    procinfo.retoffset:=-funcretsym^.address;
-                   if (procinfo.flags and pi_operator)<>0 then
+                   if ((procinfo.flags and pi_operator)<>0) and
+                     assigned(opsym) then
                      {opsym^.address:=procinfo.call_offset; is wrong PM }
                      opsym^.address:=-procinfo.retoffset;
                    { eax is modified by a function }
@@ -1271,7 +1272,15 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.88  1999-06-15 13:19:46  pierre
+  Revision 1.89  1999-06-17 13:19:54  pierre
+   * merged from 0_99_12 branch
+
+  Revision 1.88.2.1  1999/06/17 12:51:46  pierre
+   * changed is_assignment_overloaded into
+      function assignment_overloaded : pprocdef
+      to allow overloading of assignment with only different result type
+
+  Revision 1.88  1999/06/15 13:19:46  pierre
    * better uninitialized var tests for TP mode
 
   Revision 1.87  1999/05/27 19:44:50  peter

compiler/psub.pas

@@ -355,7 +355,7 @@ begin
 {$ifndef UseNiceNames}
   if assigned(procinfo._class) then
     if (pos('_$$_',procprefix)=0) then
-      hs:=procprefix+'_$$_'+procinfo._class^.objname^+'_'+sp
+      hs:=procprefix+'_$$_'+procinfo._class^.objname^+'_$$_'+sp
     else
       hs:=procprefix+'_$'+sp;
 {$else UseNiceNames}
@@ -582,7 +582,11 @@ begin
                    procinfo.flags:=procinfo.flags or pi_operator;
                    parse_proc_head(pooperator);
                    if token<>ID then
-                     consume(ID)
+                     begin
+                        opsym:=nil;
+                        if not(m_result in aktmodeswitches) then
+                          consume(ID);
+                     end
                    else
                      begin
                        opsym:=new(pvarsym,init(pattern,voiddef));
@@ -604,7 +608,12 @@ begin
                          orddef) or (porddef(aktprocsym^.definition^.
                          retdef)^.typ<>bool8bit)) then
                         Message(parser_e_comparative_operator_return_boolean);
-                       opsym^.definition:=aktprocsym^.definition^.retdef;
+                       if assigned(opsym) then
+                         opsym^.definition:=aktprocsym^.definition^.retdef;
+                       { We need to add the retrun type in the mangledname
+                         to allow overloading with just different results !! (PM) }
+                       aktprocsym^.definition^.setmangledname(
+                         aktprocsym^.definition^.mangledname+'$$'+hs);
                      end;
                  end;
   end;
@@ -1131,7 +1140,10 @@ begin
         while (assigned(pd)) and (assigned(pd^.nextoverloaded)) do
          begin
            if not(m_repeat_forward in aktmodeswitches) or
-              equal_paras(aktprocsym^.definition^.para1,pd^.nextoverloaded^.para1,false) then
+              (equal_paras(aktprocsym^.definition^.para1,pd^.nextoverloaded^.para1,false) and
+              { for operators equal_paras is not enough !! }
+              (((aktprocsym^.definition^.options and pooperator)=0) or (optoken<>ASSIGNMENT) or
+               is_equal(pd^.nextoverloaded^.retdef,aktprocsym^.definition^.retdef))) then
              begin
                if pd^.nextoverloaded^.forwarddef then
                { remove the forward definition  but don't delete it,      }
@@ -1265,7 +1277,8 @@ begin
       end;
    end;
 { insert opsym only in the right symtable }
-  if ((procinfo.flags and pi_operator)<>0) and not parse_only then
+  if ((procinfo.flags and pi_operator)<>0) and assigned(opsym)
+     and not parse_only then
     begin
       if ret_in_param(aktprocsym^.definition^.retdef) then
         begin
@@ -1779,7 +1792,15 @@ end.
 
 {
   $Log$
-  Revision 1.1  1999-06-11 13:21:37  peter
+  Revision 1.2  1999-06-17 13:19:56  pierre
+   * merged from 0_99_12 branch
+
+  Revision 1.1.2.1  1999/06/17 12:44:47  pierre
+    * solve problems related to assignment overloading
+    * support Delphi syntax for operator
+    * avoid problems if local procedure in operator
+
+  Revision 1.1  1999/06/11 13:21:37  peter
     * reinserted
 
   Revision 1.153  1999/06/02 22:44:14  pierre

compiler/tcadd.pas

@@ -109,6 +109,7 @@ implementation
          { overloaded operator ? }
          if (p^.treetype=starstarn) or
             (ld^.deftype=recorddef) or
+            (ld^.deftype=arraydef) or
             { <> and = are defined for classes }
             ((ld^.deftype=objectdef) and
              (not(pobjectdef(ld)^.isclass) or
@@ -116,6 +117,7 @@ implementation
              )
             ) or
             (rd^.deftype=recorddef) or
+            (rd^.deftype=arraydef) or
             { <> and = are defined for classes }
             ((rd^.deftype=objectdef) and
              (not(pobjectdef(rd)^.isclass) or
@@ -1094,7 +1096,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  1999-06-02 10:11:52  florian
+  Revision 1.35  1999-06-17 13:19:57  pierre
+   * merged from 0_99_12 branch
+
+  Revision 1.34.2.1  1999/06/17 12:35:23  pierre
+   * allow array binary operator overloading if not with orddef
+
+  Revision 1.34  1999/06/02 10:11:52  florian
     * make cycle fixed i.e. compilation with 0.99.10
     * some fixes for qword
     * start of register calling conventions

compiler/tccnv.pas

@@ -625,11 +625,13 @@ implementation
               exit;
             end;
          end;
-
-       if is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then
+       aprocdef:=assignment_overloaded(p^.left^.resulttype,p^.resulttype);
+       if assigned(aprocdef) then
          begin
             procinfo.flags:=procinfo.flags or pi_do_call;
             hp:=gencallnode(overloaded_operators[assignment],nil);
+            { tell explicitly which def we must use !! (PM) }
+            hp^.procdefinition:=aprocdef;
             hp^.left:=gencallparanode(p^.left,nil);
             putnode(p);
             p:=hp;
@@ -809,9 +811,10 @@ implementation
                { possible, if the source is no register    }
                if ((p^.resulttype^.deftype in [recorddef,stringdef,arraydef]) or
                    ((p^.resulttype^.deftype=objectdef) and not(pobjectdef(p^.resulttype)^.isclass))
-                  ) and (p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) and
-                  {it also works if the assignment is overloaded }
-                  not is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then
+                  ) and (p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) { and
+                   it also works if the assignment is overloaded
+                   YES but this code is not executed if assignment is overloaded (PM)
+                  not assigned(assignment_overloaded(p^.left^.resulttype,p^.resulttype))} then
                  CGMessage(cg_e_illegal_type_conversion);
             end
            else
@@ -912,7 +915,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  1999-06-15 18:58:35  peter
+  Revision 1.38  1999-06-17 13:19:58  pierre
+   * merged from 0_99_12 branch
+
+  Revision 1.35.2.3  1999/06/17 12:51:48  pierre
+   * changed is_assignment_overloaded into
+      function assignment_overloaded : pprocdef
+      to allow overloading of assignment with only different result type
+
+  Revision 1.37  1999/06/15 18:58:35  peter
     * merged
 
   Revision 1.36  1999/06/13 22:41:06  peter

compiler/tcld.pas

@@ -432,7 +432,13 @@ implementation
         { looks a little bit dangerous to me            }
         { len-1 gives problems with is_open_array if len=0, }
         { is_open_array checks now for isconstructor (FK)   }
-        p^.resulttype:=new(parraydef,init(0,len-1,s32bitdef));
+      { skip if already done ! (PM) }
+        if not assigned(p^.resulttype) or
+           (p^.resulttype^.deftype<>arraydef) or
+           not parraydef(p^.resulttype)^.IsConstructor or
+           (parraydef(p^.resulttype)^.lowrange<>0) or
+           (parraydef(p^.resulttype)^.highrange<>len-1) then
+          p^.resulttype:=new(parraydef,init(0,len-1,s32bitdef));
         parraydef(p^.resulttype)^.definition:=pd;
         parraydef(p^.resulttype)^.IsConstructor:=true;
         parraydef(p^.resulttype)^.IsVariant:=varia;
@@ -454,7 +460,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  1999-06-01 19:26:39  peter
+  Revision 1.35  1999-06-17 13:19:59  pierre
+   * merged from 0_99_12 branch
+
+  Revision 1.34.2.1  1999/06/17 12:33:39  pierre
+   * avoid warning with extdebug for arrayconstruct
+
+  Revision 1.34  1999/06/01 19:26:39  peter
     * fixed bug 249
 
   Revision 1.33  1999/05/27 19:45:21  peter