paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-23 18:35:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: implement delphi style class operators:

Browse Source 
- 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 -
This commit is contained in:
paul 2010-12-24 05:43:36 +00:00
parent 525f4fea43
commit b811f1be15
8 changed files with 333 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

14
compiler/htypechk.pas
View File

@ -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);

134
compiler/pdecsub.pas
View File

@ -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
begin
sp:=overloaded_names[optoken];
orgsp:=sp;
end
else
begin
sp:=pattern;
orgsp:=orgpattern;
consume(_ID);
end;
consume_proc_name;
{ 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
sp := lower(sp);
if (token<>_POINT) then
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;
_OPERATOR :
else
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

15
compiler/psub.pas
View File

@ -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
@ -1879,7 +1880,7 @@ implementation
else
begin
case idtoken of
_RESOURCESTRING :
_RESOURCESTRING:
begin
{ m_class is needed, because the resourcestring
loading is in the ObjPas unit }
@ -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

31
compiler/ptype.pas
View File

@ -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;

2
compiler/symdef.pas
View File

@ -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;

60
compiler/tokens.pas
View File

@ -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 }
);

125
tests/test/terecs6.pp Normal file
View File

@ -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.