Browse Source

+ add flags that allow checking for overloads with isbinaryoverloaded() and isunaryoverloaded() without modifying the passed in node or even checking for normally non-overloadable operators

git-svn-id: trunk@39258 -
svenbarth 7 years ago
parent
commit
9b45f58c0b
6 changed files with 75 additions and 33 deletions
  1. 5 5
      .gitattributes
  2. 62 20
      compiler/htypechk.pas
  3. 1 1
      compiler/nadd.pas
  4. 1 1
      compiler/ninl.pas
  5. 5 5
      compiler/nmat.pas
  6. 1 1
      compiler/nset.pas

+ 5 - 5
.gitattributes

@@ -192,7 +192,7 @@ compiler/hlcg2ll.pas svneol=native#text/plain
 compiler/hlcgobj.pas svneol=native#text/plain
 compiler/html/i386/readme.txt svneol=native#text/plain
 compiler/html/powerpc/readme.txt svneol=native#text/plain
-compiler/htypechk.pas svneol=native#text/plain
+compiler/htypechk.pas -text svneol=native#text/plain
 compiler/i386/aoptcpu.pas svneol=native#text/plain
 compiler/i386/aoptcpub.pas svneol=native#text/plain
 compiler/i386/aoptcpud.pas svneol=native#text/plain
@@ -462,7 +462,7 @@ compiler/msg/errorru.msg svneol=native#text/plain
 compiler/msg/errorues.msg svneol=native#text/plain
 compiler/msgidx.inc svneol=native#text/plain
 compiler/msgtxt.inc svneol=native#text/plain
-compiler/nadd.pas svneol=native#text/plain
+compiler/nadd.pas -text svneol=native#text/plain
 compiler/nbas.pas svneol=native#text/plain
 compiler/ncal.pas svneol=native#text/plain
 compiler/ncgadd.pas svneol=native#text/plain
@@ -490,15 +490,15 @@ compiler/ncon.pas svneol=native#text/plain
 compiler/nflw.pas svneol=native#text/plain
 compiler/ngenutil.pas svneol=native#text/plain
 compiler/ngtcon.pas svneol=native#text/plain
-compiler/ninl.pas svneol=native#text/plain
+compiler/ninl.pas -text svneol=native#text/plain
 compiler/nld.pas svneol=native#text/plain
-compiler/nmat.pas svneol=native#text/plain
+compiler/nmat.pas -text svneol=native#text/plain
 compiler/nmem.pas svneol=native#text/plain
 compiler/nobj.pas svneol=native#text/plain
 compiler/nobjc.pas svneol=native#text/plain
 compiler/node.pas svneol=native#text/plain
 compiler/nopt.pas svneol=native#text/plain
-compiler/nset.pas svneol=native#text/plain
+compiler/nset.pas -text svneol=native#text/plain
 compiler/nutils.pas svneol=native#text/plain
 compiler/objcasm.pas svneol=native#text/plain
 compiler/objcdef.pas svneol=native#text/plain

+ 62 - 20
compiler/htypechk.pas

@@ -152,10 +152,22 @@ interface
     function token2managementoperator(optoken:ttoken):tmanagementoperator;
 
     { check operator args and result type }
+
+    type
+      toverload_check_flag = (
+        ocf_check_non_overloadable, { also check operators that are (currently) considered as
+                                      not overloadable (e.g. the "+" operator for dynamic arrays
+                                      if modeswitch arrayoperators is active) }
+        ocf_check_only              { only check whether the operator is overloaded, but don't
+                                      modify the passed in node (return true if the operator is
+                                      overloaded, false otherwise) }
+      );
+      toverload_check_flags = set of toverload_check_flag;
+
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
     function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
-    function isunaryoverloaded(var t : tnode) : boolean;
-    function isbinaryoverloaded(var t : tnode) : boolean;
+    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
 
     { Register Allocation }
     procedure make_not_regable(p : tnode; how: tregableinfoflags);
@@ -706,7 +718,7 @@ implementation
       end;
 
 
-    function isunaryoverloaded(var t : tnode) : boolean;
+    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
       var
         ld      : tdef;
         optoken : ttoken;
@@ -728,11 +740,11 @@ implementation
         else
           inlinenumber:=in_none;
 
-        if not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
+        if not (ocf_check_non_overloadable in ocf) and not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
           exit;
 
         { operator overload is possible }
-        result:=true;
+        result:=not (ocf_check_only in ocf);
 
         optoken:=NOTOKEN;
         case t.nodetype of
@@ -752,8 +764,11 @@ implementation
         end;
         if (optoken=NOTOKEN) then
           begin
-            CGMessage(parser_e_operator_not_overloaded);
-            t:=cnothingnode.create;
+            if not (ocf_check_only in ocf) then
+              begin
+                CGMessage(parser_e_operator_not_overloaded);
+                t:=cnothingnode.create;
+              end;
             exit;
           end;
 
@@ -771,10 +786,13 @@ implementation
         { stop when there are no operators found }
         if candidates.count=0 then
           begin
-            CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
             candidates.free;
             ppn.free;
-            t:=cnothingnode.create;
+            if not (ocf_check_only in ocf) then
+              begin
+                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
+                t:=cnothingnode.create;
+              end;
             exit;
           end;
 
@@ -789,15 +807,18 @@ implementation
         { exit when no overloads are found }
         if cand_cnt=0 then
           begin
-            CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
             candidates.free;
             ppn.free;
-            t:=cnothingnode.create;
+            if not (ocf_check_only in ocf) then
+              begin
+                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
+                t:=cnothingnode.create;
+              end;
             exit;
           end;
 
         { Multiple candidates left? }
-        if cand_cnt>1 then
+        if (cand_cnt>1) and not (ocf_check_only in ocf) then
           begin
             CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
@@ -810,6 +831,13 @@ implementation
           end;
         candidates.free;
 
+        if ocf_check_only in ocf then
+          begin
+            ppn.free;
+            result:=true;
+            exit;
+          end;
+
         addsymref(operpd.procsym);
 
         { the nil as symtable signs firstcalln that this is
@@ -822,7 +850,7 @@ implementation
       end;
 
 
-    function isbinaryoverloaded(var t : tnode) : boolean;
+    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
       var
         rd,ld   : tdef;
         optoken : ttoken;
@@ -915,11 +943,14 @@ implementation
         { load easier access variables }
         ld:=tbinarynode(t).left.resultdef;
         rd:=tbinarynode(t).right.resultdef;
-        if not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
+        if not (ocf_check_non_overloadable in ocf) and
+            not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
           exit;
 
         { operator overload is possible }
-        result:=true;
+        { if we only check for the existance of the overload, then we assume that
+          it is not overloaded }
+        result:=not (ocf_check_only in ocf);
 
         case t.nodetype of
            equaln:
@@ -964,16 +995,19 @@ implementation
              optoken:=_OP_IN;
            else
              begin
-               CGMessage(parser_e_operator_not_overloaded);
-               t:=cnothingnode.create;
+               if not (ocf_check_only in ocf) then
+                 begin
+                   CGMessage(parser_e_operator_not_overloaded);
+                   t:=cnothingnode.create;
+                 end;
                exit;
              end;
         end;
 
-        cand_cnt:=search_operator(optoken,optoken<>_NE);
+        cand_cnt:=search_operator(optoken,(optoken<>_NE) and not (ocf_check_only in ocf));
 
         { no operator found for "<>" then search for "=" operator }
-        if (cand_cnt=0) and (optoken=_NE) then
+        if (cand_cnt=0) and (optoken=_NE) and not (ocf_check_only in ocf) then
           begin
             ppn.free;
             ppn:=nil;
@@ -985,7 +1019,15 @@ implementation
         if (cand_cnt=0) then
           begin
             ppn.free;
-            t:=cnothingnode.create;
+            if not (ocf_check_only in ocf) then
+              t:=cnothingnode.create;
+            exit;
+          end;
+
+        if ocf_check_only in ocf then
+          begin
+            ppn.free;
+            result:=true;
             exit;
           end;
 

+ 1 - 1
compiler/nadd.pas

@@ -1316,7 +1316,7 @@ implementation
 
          { allow operator overloading }
          hp:=self;
-         if isbinaryoverloaded(hp) then
+         if isbinaryoverloaded(hp,[]) then
            begin
               result:=hp;
               exit;

+ 1 - 1
compiler/ninl.pas

@@ -3161,7 +3161,7 @@ implementation
                            else
                              begin
                                hp:=self;
-                               if isunaryoverloaded(hp) then
+                               if isunaryoverloaded(hp,[]) then
                                  begin
                                    { inc(rec) and dec(rec) assigns result value to argument }
                                    result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp);

+ 5 - 5
compiler/nmat.pas

@@ -227,7 +227,7 @@ implementation
 
          { allow operator overloading }
          t:=self;
-         if isbinaryoverloaded(t) then
+         if isbinaryoverloaded(t,[]) then
            begin
               result:=t;
               exit;
@@ -787,7 +787,7 @@ implementation
 
          { allow operator overloading }
          t:=self;
-         if isbinaryoverloaded(t) then
+         if isbinaryoverloaded(t,[]) then
            begin
               result:=t;
               exit;
@@ -1004,7 +1004,7 @@ implementation
            begin
              { allow operator overloading }
              t:=self;
-             if isunaryoverloaded(t) then
+             if isunaryoverloaded(t,[]) then
                begin
                   result:=t;
                   exit;
@@ -1136,7 +1136,7 @@ implementation
           begin
             { allow operator overloading }
             t:=self;
-            if isunaryoverloaded(t) then
+            if isunaryoverloaded(t,[]) then
               begin
                 result:=t;
                 exit;
@@ -1315,7 +1315,7 @@ implementation
            begin
              { allow operator overloading }
              t:=self;
-             if isunaryoverloaded(t) then
+             if isunaryoverloaded(t,[]) then
                begin
                   result:=t;
                   exit;

+ 1 - 1
compiler/nset.pas

@@ -239,7 +239,7 @@ implementation
            internalerror(20021126);
 
          t:=self;
-         if isbinaryoverloaded(t) then
+         if isbinaryoverloaded(t,[]) then
            begin
              result:=t;
              exit;