* pdecsub.pas, parse_proc_dec: always parse operator overload heads as block type bt_body so that operators like ">", "=>" or "<>" are resolved to the correct tokens ("<>" would be a sequence of "_LSHARPBRACKET _RSHARPBRACKET" instead of _NE otherwise). Fixes Mantis #21127

git-svn-id: trunk@21266 -
This commit is contained in:
svenbarth 2012-05-09 12:32:34 +00:00
parent 343b8e299c
commit 4fc7515591
3 changed files with 312 additions and 0 deletions

1
.gitattributes vendored
View File

@ -10554,6 +10554,7 @@ tests/test/terecs10.pp svneol=native#text/pascal
tests/test/terecs11.pp svneol=native#text/pascal
tests/test/terecs12.pp svneol=native#text/pascal
tests/test/terecs13.pp svneol=native#text/pascal
tests/test/terecs14.pp svneol=native#text/pascal
tests/test/terecs2.pp svneol=native#text/pascal
tests/test/terecs3.pp svneol=native#text/pascal
tests/test/terecs4.pp svneol=native#text/pascal

View File

@ -966,6 +966,7 @@ implementation
locationstr: string;
i: integer;
found: boolean;
old_block_type: tblock_type;
procedure read_returndef(pd: tprocdef);
var
@ -1130,8 +1131,14 @@ implementation
if (token=_OPERATOR) or
(isclassmethod and (idtoken=_OPERATOR)) then
begin
{ we need to set the block type to bt_body, so that operator names
like ">", "=>" or "<>" are parsed correctly instead of e.g.
_LSHARPBRACKET and _RSHARPBRACKET for "<>" }
old_block_type:=block_type;
block_type:=bt_body;
consume(_OPERATOR);
parse_proc_head(astruct,potype_operator,pd);
block_type:=old_block_type;
if assigned(pd) then
begin
{ operators always need to be searched in all units }

304
tests/test/terecs14.pp Normal file
View File

@ -0,0 +1,304 @@
program terecs14;
{$mode objfpc}
{$modeswitch advancedrecords}
{$apptype console}
uses
SysUtils;
{$define enableoperators}
{ $define enablebitwise}
type
TFoo = record
F: Integer;
class operator Explicit(a: TFoo): Integer;
class operator :=(a: TFoo): Integer;
class operator =(a, b: TFoo): Boolean;
{$ifdef enableoperators}
class operator <>(a, b: TFoo): Boolean;
{$endif}
class operator In(a, b: TFoo): Boolean;
{$ifdef enableoperators}
class operator > (a, b: TFoo): Boolean;
class operator >= (a, b: TFoo): Boolean;
class operator < (a, b: TFoo): Boolean;
class operator <= (a, b: TFoo): Boolean;
{$endif}
class operator + (a, b: TFoo): Integer;
class operator - (a, b: TFoo): Integer;
class operator * (a, b: TFoo): Integer;
class operator / (a, b: TFoo): Integer;
class operator div (a, b: TFoo): Integer;
class operator mod (a, b: TFoo): Integer;
class operator shl (a, b: TFoo): Integer;
class operator shr (a, b: TFoo): Integer;
class operator or(a, b: TFoo): Boolean;
class operator and(a, b: TFoo): Boolean;
class operator xor(a, b: TFoo): Boolean;
class operator Not(a: TFoo): TFoo;
{$ifdef enablebitwise}
class operator or(a, b: TFoo): TFoo;
class operator and(a, b: TFoo): TFoo;
class operator xor(a, b: TFoo): TFoo;
{$endif}
class operator Inc(a: TFoo): TFoo;
class operator Dec(a: TFoo): TFoo;
class operator - (a: TFoo): TFoo;
class operator + (a: TFoo): TFoo;
// FPC operators
class operator ** (a, b: TFoo): Integer;
{$ifdef enableoperators}
class operator >< (a, b: TFoo): Integer;
{$endif}
end;
class operator TFoo.Explicit(a: TFoo): Integer;
begin
// to check the difference with implicit
Result := a.F + 1;
end;
class operator TFoo.:=(a: TFoo): Integer;
begin
Result := a.F;
end;
class operator TFoo.=(a, b: TFoo): Boolean;
begin
Result := a.F = b.F;
end;
{$ifdef enableoperators}
class operator TFoo.<>(a, b: TFoo): Boolean;
begin
Result := a.F <> b.F;
end;
{$endif}
class operator TFoo.In(a, b: TFoo): Boolean;
begin
Result := a.F in [0..b.F];
end;
{$ifdef enableoperators}
class operator TFoo.>(a, b: TFoo): Boolean;
begin
Result := a.F > b.F;
end;
class operator TFoo.>=(a, b: TFoo): Boolean;
begin
Result := a.F >= b.F;
end;
class operator TFoo.<(a, b: TFoo): Boolean;
begin
Result := a.F < b.F;
end;
class operator TFoo.<=(a, b: TFoo): Boolean;
begin
Result := a.F <= b.F;
end;
{$endif}
class operator TFoo.+(a, b: TFoo): Integer;
begin
Result := a.F + b.F;
end;
class operator TFoo.-(a, b: TFoo): Integer;
begin
Result := a.F - b.F;
end;
class operator TFoo.*(a, b: TFoo): Integer;
begin
Result := a.F * b.F;
end;
class operator TFoo./(a, b: TFoo): Integer;
begin
Result := Round(a.F / b.F);
end;
class operator TFoo.div(a, b: TFoo): Integer;
begin
Result := a.F div b.F;
end;
class operator TFoo.mod(a, b: TFoo): Integer;
begin
Result := a.F mod b.F;
end;
class operator TFoo.shl(a, b: TFoo): Integer;
begin
Result := a.F shl b.F;
end;
class operator TFoo.shr(a, b: TFoo): Integer;
begin
Result := a.F shr b.F;
end;
class operator TFoo.or(a, b: TFoo): Boolean;
begin
Result := (a.F or b.F) <> 0;
end;
class operator TFoo.and(a, b: TFoo): Boolean;
begin
Result := (a.F and b.F) <> 0;
end;
class operator TFoo.xor(a, b: TFoo): Boolean;
begin
Result := (a.F xor b.F) <> 0;
end;
class operator TFoo.not(a: TFoo): TFoo;
begin
Result.F := not a.F;
end;
{$ifdef enablebitwise}
class operator TFoo.or(a, b: TFoo): TFoo;
begin
Result.F := a.F or b.F;
end;
class operator TFoo.and(a, b: TFoo): TFoo;
begin
Result.F := a.F and b.F;
end;
class operator TFoo.xor(a, b: TFoo): TFoo;
begin
Result.F := a.F xor b.F;
end;
{$endif}
class operator TFoo.Inc(a: TFoo): TFoo;
begin
Result.F := a.F + 1;
end;
class operator TFoo.Dec(a: TFoo): TFoo;
begin
Result.F := a.F - 1;
end;
class operator TFoo.-(a: TFoo): TFoo;
begin
Result.F := -a.F;
end;
class operator TFoo.+(a: TFoo): TFoo;
begin
// to check that operator is called change the result value
Result.F := a.F+1;
end;
class operator TFoo.**(a, b: TFoo): Integer;
var
i: LongInt;
begin
Result := 1;
for i := 0 to b.F - 1 do
Result := Result * a.F;
end;
{$ifdef enableoperators}
class operator TFoo.><(a, b: TFoo): Integer;
begin
Result := a.F - b.F + 2 * (a.F + b.F);
end;
{$endif}
var
a, b: TFoo;
i: integer;
begin
a.F := 1;
b.F := 2;
if a = b then
halt(1);
{$ifdef enableoperators}
if not (a <> b) then
halt(2);
{$endif enableoperators}
if not (a in b) then
halt(3);
if (b in a) then
halt(4);
{$ifdef enableoperators}
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);
{$endif}
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);
if a + b <> 3 then
halt(15);
if a - b <> -1 then
halt(16);
if not (a or b) then
halt(17);
if a and b then
halt(18);
if not (a xor b) then
halt(19);
if (not a).F <> (not 1) then
halt(20);
{ bitwise operators current does not work if logical are defined
if (a or b).F <> (a.F or b.F) then
halt(21);
if (a and b).F <> (a.F and b.F) then
halt(22);
if (a xor b).F <> (a.F xor b.F) then
halt(23);
}
inc(a);
if a.F <> 2 then
halt(24);
dec(b);
if b.F <> 1 then
halt(25);
i := b;
if i <> 1 then
halt(26);
if Integer(b) <> 2 then
halt(27);
b := -b;
if b.F <> -1 then
halt(28);
b := +b;
if b.F <> 0 then
halt(29);
a.F := 2;
b.F := 3;
if (a ** b) <> 8 then
halt(30);
{$ifdef enableoperators}
if (a >< b) <> 9 then
halt(31);
{$endif}
WriteLn('ok');
end.