paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 06:06:13 +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

92
compiler/pdecsub.pas
View File

@ -1183,11 +1183,52 @@ implementation
var
pd : tprocdef;
locationstr: string;
old_parse_generic: boolean;
popclass: integer;
old_current_structdef: tabstractrecorddef;
old_current_genericdef,
old_current_specializedef: tobjectdef;
procedure read_returndef(pd: tprocdef);
var
popclass: integer;
old_parse_generic: boolean;
old_current_structdef: tabstractrecorddef;
old_current_genericdef,
old_current_specializedef: tobjectdef;
begin
old_parse_generic:=parse_generic;
inc(testcurobject);
{ Add ObjectSymtable to be able to find generic type definitions }
popclass:=0;
if assigned(pd.struct) and
(pd.parast.symtablelevel=normal_function_level) and
not (symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
begin
popclass:=push_nested_hierarchy(pd.struct);
parse_generic:=(df_generic in pd.struct.defoptions);
old_current_structdef:=current_structdef;
old_current_genericdef:=current_genericdef;
old_current_specializedef:=current_specializedef;
current_structdef:=pd.struct;
if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
current_genericdef:=tobjectdef(current_structdef);
if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
current_specializedef:=tobjectdef(current_structdef);
end;
single_type(pd.returndef,false,false);
if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
Message1(type_e_not_automatable,pd.returndef.typename);
if popclass>0 then
begin
current_structdef:=old_current_structdef;
current_genericdef:=old_current_genericdef;
current_specializedef:=old_current_specializedef;
dec(popclass,pop_nested_hierarchy(pd.struct));
if popclass<>0 then
internalerror(201012020);
end;
dec(testcurobject);
parse_generic:=old_parse_generic;
end;
begin
locationstr:='';
pd:=nil;
@ -1202,42 +1243,7 @@ implementation
begin
if try_to_consume(_COLON) then
begin
old_parse_generic:=parse_generic;
inc(testcurobject);
{ Add ObjectSymtable to be able to find generic type definitions }
popclass:=0;
if assigned(pd.struct) and
(pd.parast.symtablelevel=normal_function_level) and
not (symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
begin
popclass:=push_nested_hierarchy(pd.struct);
parse_generic:=(df_generic in pd.struct.defoptions);
old_current_structdef:=current_structdef;
old_current_genericdef:=current_genericdef;
old_current_specializedef:=current_specializedef;
current_structdef:=pd.struct;
if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
current_genericdef:=tobjectdef(current_structdef);
if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
current_specializedef:=tobjectdef(current_structdef);
end;
single_type(pd.returndef,false,false);
if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
Message1(type_e_not_automatable,pd.returndef.typename);
if popclass>0 then
begin
current_structdef:=old_current_structdef;
current_genericdef:=old_current_genericdef;
current_specializedef:=old_current_specializedef;
dec(popclass,pop_nested_hierarchy(pd.struct));
if popclass<>0 then
internalerror(201012020);
end;
dec(testcurobject);
parse_generic:=old_parse_generic;
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.