compiler: allow <> operator overload. search for "<>" operator first for "<>" expressions and if not found then use "=" operator + test

git-svn-id: trunk@16603 -

.gitattributes

@@ -9601,6 +9601,7 @@ tests/test/toperator4.pp svneol=native#text/plain
 tests/test/toperator5.pp svneol=native#text/plain
 tests/test/toperator6.pp svneol=native#text/plain
 tests/test/toperator7.pp svneol=native#text/plain
+tests/test/toperator8.pp svneol=native#text/pascal
 tests/test/tover1.pp svneol=native#text/plain
 tests/test/tover2.pp svneol=native#text/plain
 tests/test/tover3.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -120,7 +120,7 @@ interface
         (tok:_OP_SHR    ;nod:shrn;op_overloading_supported:true),      { binary overloading supported }
         (tok:_OP_XOR    ;nod:xorn;op_overloading_supported:true),      { binary overloading supported }
         (tok:_ASSIGNMENT;nod:assignn;op_overloading_supported:true),   { unary overloading supported }
-        (tok:_UNEQUAL   ;nod:unequaln;op_overloading_supported:false)  { binary overloading NOT supported  overload = instead }
+        (tok:_UNEQUAL   ;nod:unequaln;op_overloading_supported:true)   { binary overloading supported }
       );
 
       { true, if we are parsing stuff which allows array constructors }
@@ -560,8 +560,80 @@ implementation
         operpd  : tprocdef;
         ht      : tnode;
         ppn     : tcallparanode;
-        candidates : tcallcandidates;
         cand_cnt : integer;
+
+        function search_operator(optoken:ttoken;generror:boolean): integer;
+          var
+            candidates : tcallcandidates;
+          begin
+            { generate parameter nodes }
+            ppn:=ccallparanode.create(tbinarynode(t).right.getcopy,ccallparanode.create(tbinarynode(t).left.getcopy,nil));
+            ppn.get_paratype;
+            candidates:=tcallcandidates.create_operator(optoken,ppn);
+
+            { for commutative operators we can swap arguments and try again }
+            if (candidates.count=0) and
+               not(optoken in [_OP_SHL,_OP_SHR,_OP_DIV,_OP_MOD,_STARSTAR,_SLASH,_MINUS]) then
+              begin
+                candidates.free;
+                reverseparameters(ppn);
+                { reverse compare operators }
+                case optoken of
+                  _LT:
+                    optoken:=_GTE;
+                  _GT:
+                    optoken:=_LTE;
+                  _LTE:
+                    optoken:=_GT;
+                  _GTE:
+                    optoken:=_LT;
+                end;
+                candidates:=tcallcandidates.create_operator(optoken,ppn);
+              end;
+
+            { stop when there are no operators found }
+            result:=candidates.count;
+            if (result=0) and generror then
+              begin
+                CGMessage(parser_e_operator_not_overloaded);
+                candidates.free;
+                exit;
+              end;
+
+            if (result>0) then
+              begin
+                { Retrieve information about the candidates }
+                candidates.get_information;
+        {$ifdef EXTDEBUG}
+                { Display info when multiple candidates are found }
+                candidates.dump_info(V_Debug);
+        {$endif EXTDEBUG}
+                result:=candidates.choose_best(tabstractprocdef(operpd),false);
+              end;
+
+            { exit when no overloads are found }
+            if (result=0) and generror then
+              begin
+                CGMessage3(parser_e_operator_not_overloaded_3,ld.typename,arraytokeninfo[optoken].str,rd.typename);
+                candidates.free;
+                exit;
+              end;
+
+            { Multiple candidates left? }
+            if result>1 then
+              begin
+                CGMessage(type_e_cant_choose_overload_function);
+    {$ifdef EXTDEBUG}
+                candidates.dump_info(V_Hint);
+    {$else EXTDEBUG}
+                candidates.list(false);
+    {$endif EXTDEBUG}
+                { we'll just use the first candidate to make the
+                  call }
+              end;
+            candidates.free;
+          end;
+
       begin
         isbinaryoverloaded:=false;
         operpd:=nil;
@@ -575,9 +647,10 @@ implementation
         result:=true;
 
         case t.nodetype of
-           equaln,
-           unequaln :
+           equaln:
              optoken:=_EQUAL;
+           unequaln:
+             optoken:=_UNEQUAL;
            addn:
              optoken:=_PLUS;
            subn:
@@ -620,73 +693,24 @@ implementation
              end;
         end;
 
-        { generate parameter nodes }
-        ppn:=ccallparanode.create(tbinarynode(t).right.getcopy,ccallparanode.create(tbinarynode(t).left.getcopy,nil));
-        ppn.get_paratype;
-        candidates:=tcallcandidates.create_operator(optoken,ppn);
-
-        { for commutative operators we can swap arguments and try again }
-        if (candidates.count=0) and
-           not(optoken in [_OP_SHL,_OP_SHR,_OP_DIV,_OP_MOD,_STARSTAR,_SLASH,_MINUS]) then
-          begin
-            candidates.free;
-            reverseparameters(ppn);
-            { reverse compare operators }
-            case optoken of
-              _LT:
-                optoken:=_GTE;
-              _GT:
-                optoken:=_LTE;
-              _LTE:
-                optoken:=_GT;
-              _GTE:
-                optoken:=_LT;
-            end;
-            candidates:=tcallcandidates.create_operator(optoken,ppn);
-          end;
+        cand_cnt:=search_operator(optoken,optoken<>_UNEQUAL);
 
-        { stop when there are no operators found }
-        if candidates.count=0 then
+        { no operator found for "<>" then search for "=" operator }
+        if (cand_cnt=0) and (optoken=_UNEQUAL) then
           begin
-            CGMessage(parser_e_operator_not_overloaded);
-            candidates.free;
             ppn.free;
-            t:=cnothingnode.create;
-            exit;
+            operpd:=nil;
+            optoken:=_EQUAL;
+            cand_cnt:=search_operator(optoken,true);
           end;
 
-        { Retrieve information about the candidates }
-        candidates.get_information;
-{$ifdef EXTDEBUG}
-        { Display info when multiple candidates are found }
-        candidates.dump_info(V_Debug);
-{$endif EXTDEBUG}
-        cand_cnt:=candidates.choose_best(tabstractprocdef(operpd),false);
-
-        { exit when no overloads are found }
-        if cand_cnt=0 then
+        if (cand_cnt=0) then
           begin
-            CGMessage3(parser_e_operator_not_overloaded_3,ld.typename,arraytokeninfo[optoken].str,rd.typename);
-            candidates.free;
             ppn.free;
             t:=cnothingnode.create;
             exit;
           end;
 
-        { Multiple candidates left? }
-        if cand_cnt>1 then
-          begin
-            CGMessage(type_e_cant_choose_overload_function);
-{$ifdef EXTDEBUG}
-            candidates.dump_info(V_Hint);
-{$else EXTDEBUG}
-            candidates.list(false);
-{$endif EXTDEBUG}
-            { we'll just use the first candidate to make the
-              call }
-          end;
-        candidates.free;
-
         addsymref(operpd.procsym);
 
         { the nil as symtable signs firstcalln that this is
@@ -697,7 +721,9 @@ implementation
           skip the overload choosing in callnode.pass_typecheck }
         tcallnode(ht).procdefinition:=operpd;
 
-        if t.nodetype=unequaln then
+        { if we found "=" operator for "<>" expression then use it
+          together with "not" }
+        if (t.nodetype=unequaln) and (optoken=_EQUAL) then
           ht:=cnotnode.create(ht);
         t:=ht;
       end;

compiler/pdecsub.pas

@@ -1284,8 +1284,6 @@ implementation
                        optoken := _OP_ENUMERATOR
                      else
                        Message1(parser_e_overload_operator_failed,'');
-                   _UNEQUAL:
-                     Message1(parser_e_overload_operator_failed,'=');
                    else
                      Message1(parser_e_overload_operator_failed,'');
                  end;
@@ -1317,7 +1315,7 @@ implementation
                   else
                    begin
                      single_type(pd.returndef,false,false);
-                     if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
+                     if (optoken in [_EQUAL,_UNEQUAL,_GT,_LT,_GTE,_LTE]) and
                         ((pd.returndef.typ<>orddef) or
                          (torddef(pd.returndef).ordtype<>pasbool)) then
                         Message(parser_e_comparative_operator_return_boolean);

compiler/symtable.pas

@@ -268,7 +268,7 @@ interface
          ('error',
           'plus','minus','star','slash','equal',
           'greater','lower','greater_or_equal',
-          'lower_or_equal',
+          'lower_or_equal', 'not_equal',
           'sym_diff','starstar',
           'as','is','in','or',
           'and','div','mod','not','shl','shr','xor',

compiler/tokens.pas

@@ -39,6 +39,7 @@ type
     _LT,
     _GTE,
     _LTE,
+    _UNEQUAL,
     _SYMDIF,
     _STARSTAR,
     _OP_AS,
@@ -56,7 +57,6 @@ type
     _OP_ENUMERATOR,
     { special chars }
     _CARET,
-    _UNEQUAL,
     _LECKKLAMMER,
     _RECKKLAMMER,
     _POINT,
@@ -302,6 +302,7 @@ const
       (str:'<'             ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'>='            ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'<='            ;special:true ;keyword:m_none;op:NOTOKEN),
+      (str:'<>'            ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'><'            ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'**'            ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'as'            ;special:true ;keyword:m_none;op:NOTOKEN),
@@ -319,7 +320,6 @@ const
       (str:'enumerator'    ;special:true ;keyword:m_none;op:NOTOKEN),
     { Special chars }
       (str:'^'             ;special:true ;keyword:m_none;op:NOTOKEN),
-      (str:'<>'            ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'['             ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:']'             ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'.'             ;special:true ;keyword:m_none;op:NOTOKEN),

tests/test/toperator8.pp

@@ -0,0 +1,62 @@
+program toperator8;
+
+{$mode objfpc}
+{$apptype console}
+
+type
+  TFoo = record
+    F: Integer;
+  end;
+
+  TBar = record
+    F: Integer;
+  end;
+
+var
+  Test: Integer = 0;
+
+operator =(const F1, F2: TFoo): Boolean;
+begin
+  Result := F1.F = F2.F;
+  Test := 1;
+end;
+
+operator <>(const F1, F2: TFoo): Boolean;
+begin
+  Result := F1.F <> F2.F;
+  Test := 2;
+end;
+
+operator =(const F1, F2: TBar): Boolean;
+begin
+  Result := F1.F = F2.F;
+  Test := 3;
+end;
+
+var
+  F1, F2: TFoo;
+  B1, B2: TBar;
+begin
+  F1.F := 1;
+  F2.F := 2;
+  if F1 = F2 then
+    halt(1);
+  if Test <> 1 then
+    halt(2);
+  F2.F := 1;
+  if F1 <> F2 then
+    halt(3);
+  if Test <> 2 then
+    halt(4);
+  B1.F := 1;
+  B2.F := 2;
+  if B1 = B2 then
+    halt(5);
+  if Test <> 3 then
+    halt(6);
+  B2.F := 1;
+  if B1 <> B2 then
+    halt(7);
+  WriteLn('ok');
+end.
+