paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 11:39:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler:

Browse Source 
- parse operator return type the same way as we parse function return type - which pushing structures into the symtable and allowing self references, 
  - this change allows class operators to have return type = structure where they are defined
  - extend test to check LogicalNot operator which can be finally compiled now

git-svn-id: trunk@16627 -
This commit is contained in:
paul 2010-12-24 07:22:48 +00:00
parent 3c6fde4acc
commit 8c8c1fc151
2 changed files with 85 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
compiler/pdecsub.pas
View File

@ -1183,24 +1183,14 @@ implementation
var
pd : tprocdef;
locationstr: string;
old_parse_generic: boolean;
procedure read_returndef(pd: tprocdef);
var
popclass: integer;
old_parse_generic: boolean;
old_current_structdef: tabstractrecorddef;
old_current_genericdef,
old_current_specializedef: tobjectdef;
begin
locationstr:='';
pd:=nil;
case token of
_FUNCTION :
begin
consume(_FUNCTION);
if parse_proc_head(astruct,potype_function,pd) then
begin
{ pd=nil when it is a interface mapping }
if assigned(pd) then
begin
if try_to_consume(_COLON) then
begin
old_parse_generic:=parse_generic;
inc(testcurobject);
@ -1237,7 +1227,23 @@ implementation
end;
dec(testcurobject);
parse_generic:=old_parse_generic;
end;
begin
locationstr:='';
pd:=nil;
case token of
_FUNCTION :
begin
consume(_FUNCTION);
if parse_proc_head(astruct,potype_function,pd) then
begin
{ pd=nil when it is a interface mapping }
if assigned(pd) then
begin
if try_to_consume(_COLON) then
begin
read_returndef(pd);
if (target_info.system in [system_m68k_amiga]) then
begin
if (idtoken=_LOCATION) then
@ -1349,6 +1355,8 @@ implementation
include(pd.procoptions,po_overload);
if pd.parast.symtablelevel>normal_function_level then
Message(parser_e_no_local_operator);
if isclassmethod then
include(pd.procoptions,po_classmethod);
if token<>_ID then
begin
if not(m_result in current_settings.modeswitches) then
@ -1367,7 +1375,7 @@ implementation
end
else
begin
single_type(pd.returndef,false,false);
read_returndef(pd);
if (optoken in [_EQ,_NE,_GT,_LT,_GTE,_LTE,_OP_IN]) and
((pd.returndef.typ<>orddef) or
(torddef(pd.returndef).ordtype<>pasbool)) then

40
tests/test/terecs6.pp
View File

@ -1,4 +1,4 @@
program Project1;
program terecs6;
{$mode delphi}
{$apptype console}
@ -26,10 +26,10 @@ type
class operator LogicalOr(a, b: TFoo): Boolean;
class operator LogicalAnd(a, b: TFoo): Boolean;
class operator LogicalXor(a, b: TFoo): Boolean;
// class operator LogicalNot(a: TFoo): TFoo;
// class operator BitwiseOr(a, b: TFoo): TFoo;
// class operator BitwiseAnd(a, b: TFoo): TFoo;
// class operator BitwiseXor(a, b: TFoo): TFoo;
class operator LogicalNot(a: TFoo): TFoo;
class operator BitwiseOr(a, b: TFoo): TFoo;
class operator BitwiseAnd(a, b: TFoo): TFoo;
class operator BitwiseXor(a, b: TFoo): TFoo;
// class operator Inc(a: TFoo): TFoo;
// class operator Dec(a: TFoo): TFoo;
end;
@ -124,6 +124,26 @@ begin
Result := (a.F xor b.F) <> 0;
end;
class operator TFoo.LogicalNot(a: TFoo): TFoo;
begin
Result.F := not a.F;
end;
class operator TFoo.BitwiseOr(a, b: TFoo): TFoo;
begin
Result.F := a.F or b.F;
end;
class operator TFoo.BitwiseAnd(a, b: TFoo): TFoo;
begin
Result.F := a.F and b.F;
end;
class operator TFoo.BitwiseXor(a, b: TFoo): TFoo;
begin
Result.F := a.F xor b.F;
end;
var
a, b: TFoo;
begin
@ -167,5 +187,15 @@ begin
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);
}
WriteLn('ok');
end.