compiler: implement delphi style class operators:

- add delphi operator tokens into token enum
  - move optoken search from parse_proc_dec to parse_proc_head and add delphi operator name search
  - map delphi operators to existent fpc operators and skip some delphi operators for now
  - implement store operators in record symtable and search in it

git-svn-id: trunk@16624 -

.gitattributes

@@ -9328,6 +9328,7 @@ tests/test/terecs2.pp svneol=native#text/pascal
 tests/test/terecs3.pp svneol=native#text/pascal
 tests/test/terecs4.pp svneol=native#text/pascal
 tests/test/terecs5.pp svneol=native#text/pascal
+tests/test/terecs6.pp svneol=native#text/pascal
 tests/test/terecs_u1.pp svneol=native#text/pascal
 tests/test/testcmem.pp svneol=native#text/plain
 tests/test/testda1.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -1877,6 +1877,20 @@ implementation
            (FOperator=NOTOKEN) and
            (FProcsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
           collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList)
+        else
+        if (FOperator<>NOTOKEN) then
+          begin
+            { check operands and if they contain records then search in records,
+              then search in unit }
+            pt:=tcallparanode(FParaNode);
+            while assigned(pt) do
+              begin
+                if (pt.resultdef.typ=recorddef) then
+                  collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList);
+                pt:=tcallparanode(pt.right);
+              end;
+            collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit);
+          end
         else
           collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit);
 

compiler/pdecsub.pas

@@ -807,6 +807,85 @@ implementation
         old_current_structdef: tabstractrecorddef;
         old_current_genericdef,
         old_current_specializedef : tobjectdef;
+        lasttoken,lastidtoken: ttoken;
+
+        procedure parse_operator_name;
+         begin
+           if (lasttoken in [first_overloaded..last_overloaded]) then
+            begin
+              optoken:=token;
+            end
+           else
+            begin
+              case lasttoken of
+                _CARET:
+                  Message1(parser_e_overload_operator_failed,'**');
+                _ID:
+                  if lastidtoken=_ENUMERATOR then
+                    optoken:=_OP_ENUMERATOR
+                  else
+                  if (m_delphi in current_settings.modeswitches) then
+                    case lastidtoken of
+//                         _IMPLICIT:optoken:=;
+//                         _EXPLICIT:optoken:=;
+                      _NEGATIVE:optoken:=_MINUS;
+//                         _POSITIVE:optoken:=_PLUS;
+//                         _INC:optoken:=;
+//                         _DEC:optoken:=;
+                      _LOGICALNOT:optoken:=_OP_NOT;
+                      _IN:optoken:=_OP_IN;
+                      _EQUAL:optoken:=_EQ;
+                      _NOTEQUAL:optoken:=_NE;
+                      _GREATERTHAN:optoken:=_GT;
+                      _GREATERTHANOREQUAL:optoken:=_GTE;
+                      _LESSTHAN:optoken:=_LT;
+                      _LESSTHANOREQUAL:optoken:=_LTE;
+                      _ADD:optoken:=_PLUS;
+                      _SUBTRACT:optoken:=_MINUS;
+                      _MULTIPLY:optoken:=_STAR;
+                      _DIVIDE:optoken:=_SLASH;
+                      _INTDIVIDE:optoken:=_OP_DIV;
+                      _MODULUS:optoken:=_OP_MOD;
+                      _LEFTSHIFT:optoken:=_OP_SHL;
+                      _RIGHTSHIFT:optoken:=_OP_SHR;
+                      _LOGICALAND:optoken:=_OP_AND;
+                      _LOGICALOR:optoken:=_OP_OR;
+                      _LOGICALXOR:optoken:=_OP_XOR;
+                      _BITWISEAND:optoken:=_OP_AND;
+                      _BITWISEOR:optoken:=_OP_OR;
+                      _BITWISEXOR:optoken:=_OP_XOR;
+                      else
+                        Message1(parser_e_overload_operator_failed,'');
+                    end
+                  else
+                    Message1(parser_e_overload_operator_failed,'');
+                else
+                  Message1(parser_e_overload_operator_failed,'');
+              end;
+            end;
+           sp:=overloaded_names[optoken];
+           orgsp:=sp;
+         end;
+
+        procedure consume_proc_name;
+          begin
+            lasttoken:=token;
+            lastidtoken:=idtoken;
+            if potype=potype_operator then
+              optoken:=NOTOKEN;
+            if (potype=potype_operator) and (token<>_ID) then
+              begin
+                parse_operator_name;
+                consume(token);
+              end
+            else
+              begin
+                sp:=pattern;
+                orgsp:=orgpattern;
+                consume(_ID);
+              end;
+          end;
+
       begin
         { Save the position where this procedure really starts }
         procstartfilepos:=current_tokenpos;
@@ -816,17 +895,7 @@ implementation
         pd:=nil;
         aprocsym:=nil;
 
-        if potype=potype_operator then
+        consume_proc_name;
-          begin
-            sp:=overloaded_names[optoken];
-            orgsp:=sp;
-          end
-        else
-          begin
-            sp:=pattern;
-            orgsp:=orgpattern;
-            consume(_ID);
-          end;
 
         { examine interface map: function/procedure iname.functionname=locfuncname }
         if assigned(astruct) and
@@ -866,7 +935,6 @@ implementation
 
         { method  ? }
         if not assigned(astruct) and
-           (potype<>potype_operator) and
            (symtablestack.top.symtablelevel=main_program_level) and
            try_to_consume(_POINT) then
          begin
@@ -886,17 +954,19 @@ implementation
                  current_tokenpos:=storepos;
                end;
              { consume proc name }
-             sp:=pattern;
-             orgsp:=orgpattern;
              procstartfilepos:=current_tokenpos;
-             consume(_ID);
+             consume_proc_name;
              { qualifier is class name ? }
              if (srsym.typ=typesym) and
                 (ttypesym(srsym).typedef.typ in [objectdef,recorddef]) then
               begin
                 astruct:=tabstractrecorddef(ttypesym(srsym).typedef);
-                if (token<>_POINT) and (potype in [potype_class_constructor,potype_class_destructor]) then
+                if (token<>_POINT) then
-                  sp := lower(sp);
+                  if (potype in [potype_class_constructor,potype_class_destructor]) then
+                    sp:=lower(sp)
+                  else
+                  if (potype=potype_operator)and(optoken=NOTOKEN) then
+                    parse_operator_name;
                 srsym:=tsym(astruct.symtable.Find(sp));
                 if assigned(srsym) then
                  begin
@@ -944,6 +1014,9 @@ implementation
              searchagain:=false;
              current_tokenpos:=procstartfilepos;
 
+             if (potype=potype_operator)and(optoken=NOTOKEN) then
+               parse_operator_name;
+
              srsymtable:=symtablestack.top;
              srsym:=tsym(srsymtable.Find(sp));
 
@@ -1263,32 +1336,11 @@ implementation
               if assigned(pd) then
                 pd.returndef:=voidtype;
             end;
-
+        else
-          _OPERATOR :
+          if (token=_OPERATOR) or
+             (isclassmethod and (idtoken=_OPERATOR)) then
             begin
               consume(_OPERATOR);
-              if (token in [first_overloaded..last_overloaded]) then
-               begin
-                 optoken:=token;
-               end
-              else
-               begin
-                 { Use the dummy NOTOKEN that is also declared
-                   for the overloaded_operator[] }
-                 optoken:=NOTOKEN;
-                 case token of
-                   _CARET:
-                     Message1(parser_e_overload_operator_failed,'**');
-                   _ID:
-                     if idtoken = _ENUMERATOR then
-                       optoken := _OP_ENUMERATOR
-                     else
-                       Message1(parser_e_overload_operator_failed,'');
-                   else
-                     Message1(parser_e_overload_operator_failed,'');
-                 end;
-               end;
-              consume(token);
               parse_proc_head(astruct,potype_operator,pd);
               if assigned(pd) then
                 begin

compiler/psub.pas

@@ -1841,7 +1841,8 @@ implementation
                    begin
                      { class modifier is only allowed for procedures, functions, }
                      { constructors, destructors, fields and properties          }
-                     if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR]) then
+                     if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR,_OPERATOR]) and
+                        not((token=_ID) and (idtoken=_OPERATOR)) then
                        Message(parser_e_procedure_or_function_expected);
 
                      if is_interface(current_structdef) then
@@ -1888,6 +1889,16 @@ implementation
 {                        else
                           break;}
                       end;
+                    _OPERATOR:
+                      begin
+                        if is_classdef then
+                          begin
+                            read_proc(is_classdef);
+                            is_classdef:=false;
+                          end
+                        else
+                          break;
+                      end;
                     _PROPERTY:
                       begin
                         if (m_fpc in current_settings.modeswitches) then

compiler/ptype.pas

@@ -608,7 +608,7 @@ implementation
                 consume(_CONST);
                 member_blocktype:=bt_const;
               end;
-            _ID, _CASE :
+            _ID, _CASE, _OPERATOR :
               begin
                 case idtoken of
                   _PRIVATE :
@@ -680,6 +680,32 @@ implementation
                         member_blocktype:=bt_general;
                      end
                     else
+                    if is_classdef and (idtoken=_OPERATOR) then
+                      begin
+                        oldparse_only:=parse_only;
+                        parse_only:=true;
+                        pd:=parse_proc_dec(is_classdef,current_structdef);
+
+                        { this is for error recovery as well as forward }
+                        { interface mappings, i.e. mapping to a method  }
+                        { which isn't declared yet                      }
+                        if assigned(pd) then
+                          begin
+                            parse_record_proc_directives(pd);
+
+                            handle_calling_convention(pd);
+
+                            { add definition to procsym }
+                            proc_add_definition(pd);
+                          end;
+
+                        maybe_parse_hint_directives(pd);
+
+                        parse_only:=oldparse_only;
+                        fields_allowed:=false;
+                        is_classdef:=false;
+                      end
+                      else
                       begin
                         if member_blocktype=bt_general then
                           begin
@@ -713,7 +739,8 @@ implementation
                  begin
                    { class modifier is only allowed for procedures, functions, }
                    { constructors, destructors, fields and properties          }
-                   if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR]) then
+                   if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR,_OPERATOR]) and
+                      not((token=_ID) and (idtoken=_OPERATOR)) then
                      Message(parser_e_procedure_or_function_expected);
 
                    is_classdef:=true;

compiler/symdef.pas

@@ -3095,7 +3095,7 @@ implementation
     function tabstractprocdef.no_self_node: boolean;
       begin
         Result:=([po_staticmethod,po_classmethod]<=procoptions)or
-                (proctypeoption in [potype_class_constructor,potype_class_destructor]);
+                (proctypeoption in [potype_class_constructor,potype_class_destructor,potype_operator]);
       end;
 
 

compiler/tokens.pas

@@ -106,12 +106,15 @@ type
     _ON,
     _OR,
     _TO,
+    _ADD,
     _AND,
     _ASM,
+    _DEC,
     _DIV,
     _END,
     _FAR,
     _FOR,
+    _INC,
     _MOD,
     _NIL,
     _NOT,
@@ -148,6 +151,7 @@ type
     _CDECL,
     _CLASS,
     _CONST,
+    _EQUAL,
     _FALSE,
     _FAR16,
     _FINAL,
@@ -159,6 +163,7 @@ type
     _WHILE,
     _WRITE,
     _DISPID,
+    _DIVIDE,
     _DOWNTO,
     _EXCEPT,
     _EXPORT,
@@ -190,6 +195,7 @@ type
     _IOCHECK,
     _LIBRARY,
     _MESSAGE,
+    _MODULUS,
     _PACKAGE,
     _PRIVATE,
     _PROGRAM,
@@ -205,15 +211,22 @@ type
     _CONTAINS,
     _CONTINUE,
     _CPPCLASS,
+    _EXPLICIT,
     _EXTERNAL,
     _FUNCTION,
+    _IMPLICIT,
+    _LESSTHAN,
     _LOCATION,
+    _MULTIPLY,
     _MWPASCAL,
+    _NEGATIVE,
+    _NOTEQUAL,
     _OPERATOR,
     _OPTIONAL,
     _OVERLOAD,
     _OVERRIDE,
     _PLATFORM,
+    _POSITIVE,
     _PROPERTY,
     _READONLY,
     _REGISTER,
@@ -221,12 +234,17 @@ type
     _REQUIRES,
     _RESIDENT,
     _SAFECALL,
+    _SUBTRACT,
     _SYSVBASE,
     _ASSEMBLER,
     _BITPACKED,
+    _BITWISEOR,
     _INHERITED,
+    _INTDIVIDE,
     _INTERFACE,
     _INTERRUPT,
+    _LEFTSHIFT,
+    _LOGICALOR,
     _NODEFAULT,
     _OBJCCLASS,
     _OTHERWISE,
@@ -236,15 +254,22 @@ type
     _SOFTFLOAT,
     _THREADVAR,
     _WRITEONLY,
+    _BITWISEAND,
+    _BITWISEXOR,
     _DEPRECATED,
     _DESTRUCTOR,
     _ENUMERATOR,
     _IMPLEMENTS,
     _INTERNPROC,
+    _LOGICALAND,
+    _LOGICALNOT,
+    _LOGICALXOR,
     _OLDFPCCALL,
     _OPENSTRING,
+    _RIGHTSHIFT,
     _SPECIALIZE,
     _CONSTRUCTOR,
+    _GREATERTHAN,
     _INTERNCONST,
     _REINTRODUCE,
     _SHORTSTRING,
@@ -259,12 +284,14 @@ type
     _UNIMPLEMENTED,
     _IMPLEMENTATION,
     _INITIALIZATION,
-    _RESOURCESTRING
+    _RESOURCESTRING,
+    _LESSTHANOREQUAL,
+    _GREATERTHANOREQUAL
   );
 
 const
   tokenlenmin = 1;
-  tokenlenmax = 14;
+  tokenlenmax = 18;
 
   { last operator which can be overloaded, the first_overloaded should
     be declared directly after NOTOKEN }
@@ -369,12 +396,15 @@ const
       (str:'ON'            ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OR'            ;special:false;keyword:m_all;op:_OP_OR),
       (str:'TO'            ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'ADD'           ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'AND'           ;special:false;keyword:m_all;op:_OP_AND),
       (str:'ASM'           ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'DEC'           ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'DIV'           ;special:false;keyword:m_all;op:_OP_DIV),
       (str:'END'           ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FAR'           ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'FOR'           ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'INC'           ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'MOD'           ;special:false;keyword:m_all;op:_OP_MOD),
       (str:'NIL'           ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'NOT'           ;special:false;keyword:m_all;op:_OP_NOT),
@@ -411,6 +441,7 @@ const
       (str:'CDECL'         ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CLASS'         ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'CONST'         ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'EQUAL'         ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'FALSE'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FAR16'         ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'FINAL'         ;special:false;keyword:m_none;op:NOTOKEN),
@@ -422,6 +453,7 @@ const
       (str:'WHILE'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'WRITE'         ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'DISPID'        ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'DIVIDE'        ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'DOWNTO'        ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'EXCEPT'        ;special:false;keyword:m_except;op:NOTOKEN),
       (str:'EXPORT'        ;special:false;keyword:m_none;op:NOTOKEN),
@@ -453,6 +485,7 @@ const
       (str:'IOCHECK'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'LIBRARY'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'MESSAGE'       ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'MODULUS'       ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'PACKAGE'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'PRIVATE'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'PROGRAM'       ;special:false;keyword:m_all;op:NOTOKEN),
@@ -468,15 +501,22 @@ const
       (str:'CONTAINS'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CONTINUE'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CPPCLASS'      ;special:false;keyword:m_fpc;op:NOTOKEN),
+      (str:'EXPLICIT'      ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'EXTERNAL'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'FUNCTION'      ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'IMPLICIT'      ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
+      (str:'LESSTHAN'      ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'LOCATION'      ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'MULTIPLY'      ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'MWPASCAL'      ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'NEGATIVE'      ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
+      (str:'NOTEQUAL'      ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'OPERATOR'      ;special:false;keyword:m_fpc;op:NOTOKEN),
       (str:'OPTIONAL'      ;special:false;keyword:m_none;op:NOTOKEN), { optional methods in an Objective-C protocol }
       (str:'OVERLOAD'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OVERRIDE'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'PLATFORM'      ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'POSITIVE'      ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'PROPERTY'      ;special:false;keyword:m_property;op:NOTOKEN),
       (str:'READONLY'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'REGISTER'      ;special:false;keyword:m_none;op:NOTOKEN),
@@ -484,12 +524,17 @@ const
       (str:'REQUIRES'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'RESIDENT'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'SAFECALL'      ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'SUBTRACT'      ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'SYSVBASE'      ;special:false;keyword:m_none;op:NOTOKEN),   { Syscall variation on MorphOS }
       (str:'ASSEMBLER'     ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'BITPACKED'     ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'BITWISEOR'     ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'INHERITED'     ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'INTDIVIDE'     ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'INTERFACE'     ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'INTERRUPT'     ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'LEFTSHIFT'     ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
+      (str:'LOGICALOR'     ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'NODEFAULT'     ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OBJCCLASS'     ;special:false;keyword:m_objectivec1;op:NOTOKEN),
       (str:'OTHERWISE'     ;special:false;keyword:m_all;op:NOTOKEN),
@@ -499,15 +544,22 @@ const
       (str:'SOFTFLOAT'     ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'THREADVAR'     ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'WRITEONLY'     ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'BITWISEAND'    ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
+      (str:'BITWISEXOR'    ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'DEPRECATED'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'DESTRUCTOR'    ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'ENUMERATOR'    ;special:false;keyword:m_none;op:_OP_ENUMERATOR),
       (str:'IMPLEMENTS'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'INTERNPROC'    ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'LOGICALAND'    ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
+      (str:'LOGICALNOT'    ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
+      (str:'LOGICALXOR'    ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'OLDFPCCALL'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OPENSTRING'    ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'RIGHTSHIFT'    ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'SPECIALIZE'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CONSTRUCTOR'   ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'GREATERTHAN'   ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name }
       (str:'INTERNCONST'   ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'REINTRODUCE'   ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'SHORTSTRING'   ;special:false;keyword:m_none;op:NOTOKEN),
@@ -522,7 +574,9 @@ const
       (str:'UNIMPLEMENTED' ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'IMPLEMENTATION';special:false;keyword:m_all;op:NOTOKEN),
       (str:'INITIALIZATION';special:false;keyword:m_initfinal;op:NOTOKEN),
-      (str:'RESOURCESTRING';special:false;keyword:m_all;op:NOTOKEN)
+      (str:'RESOURCESTRING';special:false;keyword:m_all;op:NOTOKEN),
+      (str:'LESSTHANOREQUAL';special:false;keyword:m_none;op:NOTOKEN),    { delphi operator name }
+      (str:'GREATERTHANOREQUAL';special:false;keyword:m_none;op:NOTOKEN)  { delphi operator name }
   );
 
 

tests/test/terecs6.pp

@@ -0,0 +1,125 @@
+program terecs6;
+
+{$mode delphi}
+{$apptype console}
+uses
+  SysUtils;
+
+type
+  TFoo = record
+    F: Integer;
+    class operator Equal(a, b: TFoo): Boolean;
+    class operator NotEqual(a, b: TFoo): Boolean;
+    class operator In(a, b: TFoo): Boolean;
+    class operator GreaterThan(a, b: TFoo): Boolean;
+    class operator GreaterThanOrEqual(a, b: TFoo): Boolean;
+    class operator LessThan(a, b: TFoo): Boolean;
+    class operator LessThanOrEqual(a, b: TFoo): Boolean;
+    class operator Multiply(a, b: TFoo): Integer;
+    class operator Divide(a, b: TFoo): Integer;
+    class operator IntDivide(a, b: TFoo): Integer;
+    class operator Modulus(a, b: TFoo): Integer;
+    class operator LeftShift(a, b: TFoo): Integer;
+    class operator RightShift(a, b: TFoo): Integer;
+ end;
+
+class operator TFoo.Equal(a, b: TFoo): Boolean;
+begin
+  Result := a.F = b.F;
+end;
+
+class operator TFoo.NotEqual(a, b: TFoo): Boolean;
+begin
+  Result := a.F <> b.F;
+end;
+
+class operator TFoo.In(a, b: TFoo): Boolean;
+begin
+  Result := a.F in [0..b.F];
+end;
+
+class operator TFoo.GreaterThan(a, b: TFoo): Boolean;
+begin
+  Result := a.F > b.F;
+end;
+
+class operator TFoo.GreaterThanOrEqual(a, b: TFoo): Boolean;
+begin
+  Result := a.F >= b.F;
+end;
+
+class operator TFoo.LessThan(a, b: TFoo): Boolean;
+begin
+  Result := a.F < b.F;
+end;
+
+class operator TFoo.LessThanOrEqual(a, b: TFoo): Boolean;
+begin
+  Result := a.F <= b.F;
+end;
+
+class operator TFoo.Multiply(a, b: TFoo): Integer;
+begin
+  Result := a.F * b.F;
+end;
+
+class operator TFoo.Divide(a, b: TFoo): Integer;
+begin
+  Result := Round(a.F / b.F);
+end;
+
+class operator TFoo.IntDivide(a, b: TFoo): Integer;
+begin
+  Result := a.F div b.F;
+end;
+
+class operator TFoo.Modulus(a, b: TFoo): Integer;
+begin
+  Result := a.F mod b.F;
+end;
+
+class operator TFoo.LeftShift(a, b: TFoo): Integer;
+begin
+  Result := a.F shl b.F;
+end;
+
+class operator TFoo.RightShift(a, b: TFoo): Integer;
+begin
+  Result := a.F shr b.F;
+end;
+
+var
+  a, b: TFoo;
+begin
+  a.F := 1;
+  b.F := 2;
+  if a = b then
+    halt(1);
+  if not (a <> b) then
+    halt(2);
+  if not (a in b) then
+    halt(3);
+  if (b in a) then
+    halt(4);
+  if a > b then
+    halt(5);
+  if a >= b then
+    halt(6);
+  if not (a < b) then
+    halt(7);
+  if not (a <= b) then
+    halt(8);
+  if a * b <> 2 then
+    halt(9);
+  if a / b <> 0 then
+    halt(10);
+  if a div b <> 0 then
+    halt(11);
+  if a mod b <> 1 then
+    halt(12);
+  if a shl b <> 4 then
+    halt(13);
+  if b shr a <> 1 then
+    halt(14);
+  WriteLn('ok');
+end.