paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 22:40:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ add flags that allow checking for overloads with isbinaryoverloaded() and isunaryoverloaded() without modifying the passed in node or even checking for normally non-overloadable operators

Browse Source 
git-svn-id: trunk@39258 -
This commit is contained in:
svenbarth 2018-06-20 19:53:34 +00:00
parent 8536abce8a
commit 9b45f58c0b
6 changed files with 75 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
.gitattributes vendored
View File

@ -192,7 +192,7 @@ compiler/hlcg2ll.pas svneol=native#text/plain
compiler/hlcgobj.pas svneol=native#text/plain
compiler/html/i386/readme.txt svneol=native#text/plain
compiler/html/powerpc/readme.txt svneol=native#text/plain
compiler/htypechk.pas svneol=native#text/plain
compiler/htypechk.pas -text svneol=native#text/plain
compiler/i386/aoptcpu.pas svneol=native#text/plain
compiler/i386/aoptcpub.pas svneol=native#text/plain
compiler/i386/aoptcpud.pas svneol=native#text/plain
@ -462,7 +462,7 @@ compiler/msg/errorru.msg svneol=native#text/plain
compiler/msg/errorues.msg svneol=native#text/plain
compiler/msgidx.inc svneol=native#text/plain
compiler/msgtxt.inc svneol=native#text/plain
compiler/nadd.pas svneol=native#text/plain
compiler/nadd.pas -text svneol=native#text/plain
compiler/nbas.pas svneol=native#text/plain
compiler/ncal.pas svneol=native#text/plain
compiler/ncgadd.pas svneol=native#text/plain
@ -490,15 +490,15 @@ compiler/ncon.pas svneol=native#text/plain
compiler/nflw.pas svneol=native#text/plain
compiler/ngenutil.pas svneol=native#text/plain
compiler/ngtcon.pas svneol=native#text/plain
compiler/ninl.pas svneol=native#text/plain
compiler/ninl.pas -text svneol=native#text/plain
compiler/nld.pas svneol=native#text/plain
compiler/nmat.pas svneol=native#text/plain
compiler/nmat.pas -text svneol=native#text/plain
compiler/nmem.pas svneol=native#text/plain
compiler/nobj.pas svneol=native#text/plain
compiler/nobjc.pas svneol=native#text/plain
compiler/node.pas svneol=native#text/plain
compiler/nopt.pas svneol=native#text/plain
compiler/nset.pas svneol=native#text/plain
compiler/nset.pas -text svneol=native#text/plain
compiler/nutils.pas svneol=native#text/plain
compiler/objcasm.pas svneol=native#text/plain
compiler/objcdef.pas svneol=native#text/plain

82
compiler/htypechk.pas
View File

@ -152,10 +152,22 @@ interface
function token2managementoperator(optoken:ttoken):tmanagementoperator;
{ check operator args and result type }
type
toverload_check_flag = (
ocf_check_non_overloadable, { also check operators that are (currently) considered as
not overloadable (e.g. the "+" operator for dynamic arrays
if modeswitch arrayoperators is active) }
ocf_check_only { only check whether the operator is overloaded, but don't
modify the passed in node (return true if the operator is
overloaded, false otherwise) }
);
toverload_check_flags = set of toverload_check_flag;
function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
function isunaryoverloaded(var t : tnode) : boolean;
function isbinaryoverloaded(var t : tnode) : boolean;
function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
{ Register Allocation }
procedure make_not_regable(p : tnode; how: tregableinfoflags);
@ -706,7 +718,7 @@ implementation
end;
function isunaryoverloaded(var t : tnode) : boolean;
function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
var
ld : tdef;
optoken : ttoken;
@ -728,11 +740,11 @@ implementation
else
inlinenumber:=in_none;
if not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
if not (ocf_check_non_overloadable in ocf) and not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
exit;
{ operator overload is possible }
result:=true;
result:=not (ocf_check_only in ocf);
optoken:=NOTOKEN;
case t.nodetype of
@ -752,8 +764,11 @@ implementation
end;
if (optoken=NOTOKEN) then
begin
CGMessage(parser_e_operator_not_overloaded);
t:=cnothingnode.create;
if not (ocf_check_only in ocf) then
begin
CGMessage(parser_e_operator_not_overloaded);
t:=cnothingnode.create;
end;
exit;
end;
@ -771,10 +786,13 @@ implementation
{ stop when there are no operators found }
if candidates.count=0 then
begin
CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
candidates.free;
ppn.free;
t:=cnothingnode.create;
if not (ocf_check_only in ocf) then
begin
CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
t:=cnothingnode.create;
end;
exit;
end;
@ -789,15 +807,18 @@ implementation
{ exit when no overloads are found }
if cand_cnt=0 then
begin
CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
candidates.free;
ppn.free;
t:=cnothingnode.create;
if not (ocf_check_only in ocf) then
begin
CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
t:=cnothingnode.create;
end;
exit;
end;
{ Multiple candidates left? }
if cand_cnt>1 then
if (cand_cnt>1) and not (ocf_check_only in ocf) then
begin
CGMessage(type_e_cant_choose_overload_function);
{$ifdef EXTDEBUG}
@ -810,6 +831,13 @@ implementation
end;
candidates.free;
if ocf_check_only in ocf then
begin
ppn.free;
result:=true;
exit;
end;
addsymref(operpd.procsym);
{ the nil as symtable signs firstcalln that this is
@ -822,7 +850,7 @@ implementation
end;
function isbinaryoverloaded(var t : tnode) : boolean;
function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
var
rd,ld : tdef;
optoken : ttoken;
@ -915,11 +943,14 @@ implementation
{ load easier access variables }
ld:=tbinarynode(t).left.resultdef;
rd:=tbinarynode(t).right.resultdef;
if not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
if not (ocf_check_non_overloadable in ocf) and
not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
exit;
{ operator overload is possible }
result:=true;
{ if we only check for the existance of the overload, then we assume that
it is not overloaded }
result:=not (ocf_check_only in ocf);
case t.nodetype of
equaln:
@ -964,16 +995,19 @@ implementation
optoken:=_OP_IN;
else
begin
CGMessage(parser_e_operator_not_overloaded);
t:=cnothingnode.create;
if not (ocf_check_only in ocf) then
begin
CGMessage(parser_e_operator_not_overloaded);
t:=cnothingnode.create;
end;
exit;
end;
end;
cand_cnt:=search_operator(optoken,optoken<>_NE);
cand_cnt:=search_operator(optoken,(optoken<>_NE) and not (ocf_check_only in ocf));
{ no operator found for "<>" then search for "=" operator }
if (cand_cnt=0) and (optoken=_NE) then
if (cand_cnt=0) and (optoken=_NE) and not (ocf_check_only in ocf) then
begin
ppn.free;
ppn:=nil;
@ -985,7 +1019,15 @@ implementation
if (cand_cnt=0) then
begin
ppn.free;
t:=cnothingnode.create;
if not (ocf_check_only in ocf) then
t:=cnothingnode.create;
exit;
end;
if ocf_check_only in ocf then
begin
ppn.free;
result:=true;
exit;
end;

2
compiler/nadd.pas
View File

@ -1316,7 +1316,7 @@ implementation
{ allow operator overloading }
hp:=self;
if isbinaryoverloaded(hp) then
if isbinaryoverloaded(hp,[]) then
begin
result:=hp;
exit;

2
compiler/ninl.pas
View File

@ -3161,7 +3161,7 @@ implementation
else
begin
hp:=self;
if isunaryoverloaded(hp) then
if isunaryoverloaded(hp,[]) then
begin
{ inc(rec) and dec(rec) assigns result value to argument }
result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp);

10
compiler/nmat.pas
View File

@ -227,7 +227,7 @@ implementation
{ allow operator overloading }
t:=self;
if isbinaryoverloaded(t) then
if isbinaryoverloaded(t,[]) then
begin
result:=t;
exit;
@ -787,7 +787,7 @@ implementation
{ allow operator overloading }
t:=self;
if isbinaryoverloaded(t) then
if isbinaryoverloaded(t,[]) then
begin
result:=t;
exit;
@ -1004,7 +1004,7 @@ implementation
begin
{ allow operator overloading }
t:=self;
if isunaryoverloaded(t) then
if isunaryoverloaded(t,[]) then
begin
result:=t;
exit;
@ -1136,7 +1136,7 @@ implementation
begin
{ allow operator overloading }
t:=self;
if isunaryoverloaded(t) then
if isunaryoverloaded(t,[]) then
begin
result:=t;
exit;
@ -1315,7 +1315,7 @@ implementation
begin
{ allow operator overloading }
t:=self;
if isunaryoverloaded(t) then
if isunaryoverloaded(t,[]) then
begin
result:=t;
exit;

2
compiler/nset.pas
View File

@ -239,7 +239,7 @@ implementation
internalerror(20021126);
t:=self;
if isbinaryoverloaded(t) then
if isbinaryoverloaded(t,[]) then
begin
result:=t;
exit;