* synchronized with trunk

git-svn-id: branches/wasm@47112 -
This commit is contained in:
nickysn 2020-10-14 22:30:41 +00:00
commit b4cdebeda3
6 changed files with 325 additions and 5 deletions

2
.gitattributes vendored
View File

@ -13394,6 +13394,8 @@ tests/tbs/tb0676.pp svneol=native#text/pascal
tests/tbs/tb0676a.pp svneol=native#text/plain
tests/tbs/tb0677.pp svneol=native#text/pascal
tests/tbs/tb0678.pp svneol=native#text/pascal
tests/tbs/tb0679.pp svneol=native#text/pascal
tests/tbs/tb0680.pp svneol=native#text/pascal
tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain
tests/tbs/ub0119.pp svneol=native#text/plain

View File

@ -305,7 +305,11 @@ unit agcpugas;
internalerror(2020041214);
end
else
lastsec:=tai_section(hp);
begin
lastsec:=tai_section(hp);
{ also reset the last encountered symbol }
lastsym:=nil;
end;
if assigned(tmplist) then
begin
@ -313,10 +317,11 @@ unit agcpugas;
tmplist.free;
tmplist:=nil;
end;
end;
ait_symbol:
begin
if tai_symbol(hp).is_global then
if tai_symbol(hp).sym.typ=AT_FUNCTION then
lastsym:=tai_symbol(hp);
end;
ait_instruction:
@ -365,7 +370,7 @@ unit agcpugas;
{ note: we can pass Nil here, because in case of a LLVM
backend this whole code shouldn't be required
anyway }
xdatasym:=current_asmdata.DefineAsmSymbol('xdata_'+lastsec.name^,AB_LOCAL,AT_DATA,nil);
xdatasym:=current_asmdata.DefineAsmSymbol('xdata_'+lastsym.sym.name,AB_LOCAL,AT_DATA,nil);
tmplist:=tasmlist.create;
new_section(tmplist,sec_pdata,lastsec.name^,0);

View File

@ -62,7 +62,10 @@ interface
cl6_count,
coper_count : integer; { should be signed }
ordinal_distance : double;
invalid : boolean;
invalid : boolean;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
saved_validity : boolean;
{$endif}
wrongparanr : byte;
end;
@ -2585,7 +2588,11 @@ implementation
{ only when the # of parameter are supported by the procedure and
it is visible }
{$ifdef DISABLE_FAST_OVERLOAD_PATCH}
if (FParalength>=pd.minparacount) and
{$else}
if (pd.seenmarker<>pointer(self)) and (FParalength>=pd.minparacount) and
{$endif}
(
(
allowdefaultparas and
@ -2625,6 +2632,7 @@ implementation
cpoptions:=cpoptions+[cpo_rtlproc];
found:=false;
hp:=FCandidateProcs;
{$ifdef DISABLE_FAST_OVERLOAD_PATCH}
while assigned(hp) do
begin
if (compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,cpoptions)>=te_equal) and
@ -2636,10 +2644,14 @@ implementation
end;
hp:=hp^.next;
end;
{$endif}
if not found then
begin
proc_add(st,pd,objcidcall);
added:=true;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
pd.seenmarker:=self;
{$endif}
end;
end;
@ -2653,6 +2665,14 @@ implementation
pd.free;
end;
end;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
{cleanup modified duplicate pd markers}
hp := FCandidateProcs;
while assigned(hp) do begin
hp^.data.seenmarker := nil;
hp := hp^.next;
end;
{$endif}
calc_distance(st,objcidcall);
@ -3239,6 +3259,8 @@ implementation
end;
function is_better_candidate(currpd,bestpd:pcandidate):integer;
var
res : integer;
@ -3489,6 +3511,9 @@ implementation
end;
{$ifdef DISABLE_FAST_OVERLOAD_PATCH}
function tcallcandidates.choose_best(var bestpd:tabstractprocdef; singlevariant: boolean):integer;
var
pd: tprocdef;
@ -3576,6 +3601,227 @@ implementation
end;
{$else}
function compare_by_old_sortout_check(pd,bestpd:pcandidate):integer;
var cpoptions : tcompare_paras_options;
begin
{ don't add duplicates, only compare visible parameters for the user }
cpoptions:=[cpo_ignorehidden];
if (po_compilerproc in bestpd^.data.procoptions) then
cpoptions:=cpoptions+[cpo_compilerproc];
if (po_rtlproc in bestpd^.data.procoptions) then
cpoptions:=cpoptions+[cpo_rtlproc];
compare_by_old_sortout_check := 0; // can't decide, bestpd probably wasn't sorted out in unpatched
if (compare_paras(pd^.data.paras,bestpd^.data.paras,cp_value_equal_const,cpoptions)>=te_equal) and
(not(po_objc in bestpd^.data.procoptions) or (bestpd^.data.messageinf.str^=pd^.data.messageinf.str^)) then
compare_by_old_sortout_check := 1; // bestpd was sorted out before patch
end;
function decide_restart(pd,bestpd:pcandidate) : boolean;
begin
decide_restart := false;
if assigned(bestpd) then
begin
{ don't restart if bestpd is marked invalid already }
if not bestpd^.invalid then
decide_restart := compare_by_old_sortout_check(pd,bestpd)<>0;
end;
end;
procedure save_validity(c : pcandidate);
begin
while assigned(c) do
begin
c^.saved_validity := c^.invalid;
c := c^.next;
end;
end;
procedure restore_validity(c : pcandidate);
begin
while assigned(c) do begin
c^.invalid := c^.saved_validity;
c := c^.next;
end;
end;
function tcallcandidates.choose_best(var bestpd:tabstractprocdef; singlevariant: boolean):integer;
var
pd: tprocdef;
besthpstart,
hp,hp2 : pcandidate;
cntpd,
res : integer;
restart : boolean;
begin
res:=0;
{
Returns the number of candidates left and the
first candidate is returned in pdbest
}
if not(assigned(FCandidateProcs)) then
begin
choose_best := 0;
exit;
end;
bestpd:=FCandidateProcs^.data;
if FCandidateProcs^.invalid then
cntpd:=0
else
cntpd:=1;
if assigned(FCandidateProcs^.next) then
begin
save_validity(FCandidateProcs);
restart := false;
{ keep restarting, until there wasn't a sorted-out besthpstart }
repeat
besthpstart:=FCandidateProcs;
bestpd:=FCandidateProcs^.data;
if restart then
begin
restore_validity(FCandidateProcs);
restart := false;
end;
{ Setup the first procdef as best, only count it as a result
when it is valid }
if FCandidateProcs^.invalid then
cntpd:=0
else
cntpd:=1;
hp:=FCandidateProcs^.next;
while assigned(hp) and not(restart) do
begin
restart := decide_restart(hp,besthpstart);
if not restart then
begin
if not singlevariant then
res:=is_better_candidate(hp,besthpstart)
else
res:=is_better_candidate_single_variant(hp,besthpstart);
end;
if restart then
begin
{ mark the sorted out invalid globally }
besthpstart^.saved_validity := true;
end
else if (res>0) then
begin
{ hp is better, flag all procs to be incompatible }
while (besthpstart<>hp) do
begin
besthpstart^.invalid:=true;
besthpstart:=besthpstart^.next;
end;
{ besthpstart is already set to hp }
bestpd:=besthpstart^.data;
cntpd:=1;
end
else if (res<0) then
begin
{ besthpstart is better, flag current hp to be incompatible }
hp^.invalid:=true;
end
else
begin
{ res=0, both are valid }
if not hp^.invalid then
inc(cntpd);
end;
hp:=hp^.next;
end;
until not(restart);
end;
{ check the alternate choices if they would have been sorted out before patch... }
{ note we have procadded the candidates, so order is reversed procadd order here.
this was also used above: each sorted-out always has an "outsorter" counterpart
deeper down the next chain
}
{ for the intial implementation, let's first do some more consistency checking}
res := 0;
hp := FCandidateProcs;
while assigned(hp) do
begin
if not(hp^.invalid) then
inc(res);
hp := hp^.next;
end;
if (res<>cntpd) then
internalerror(202002161);
{ check all valid choices for sortout }
cntpd := 0;
hp := FCandidateProcs;
while assigned(hp) do
begin
if not(hp^.invalid) then
begin
hp2 := hp^.next;
while assigned(hp2) do begin
if compare_by_old_sortout_check(hp2,hp)<>0 then
begin
hp^.invalid := true;
hp2 := nil;
end
else
hp2:=hp2^.next;
end;
if not(hp^.invalid) then
begin
inc(cntpd);
{ check for the impossible event bestpd had become invalid}
if (cntpd=1) and (hp^.data<>bestpd) then
internalerror(202002162);
end;
end;
hp := hp^.next;
end;
{ if we've found one, check the procdefs ignored for overload choosing
to see whether they contain one from a child class with the same
parameters (so the overload choosing was not influenced by their
presence, but now that we've decided which overloaded version to call,
make sure we call the version closest in terms of visibility }
if cntpd=1 then
begin
for res:=0 to FIgnoredCandidateProcs.count-1 do
begin
pd:=tprocdef(FIgnoredCandidateProcs[res]);
{ stop searching when we start comparing methods of parent of
the struct in which the current best method was found }
if assigned(pd.struct) and
(pd.struct<>tprocdef(bestpd).struct) and
def_is_related(tprocdef(bestpd).struct,pd.struct) then
break;
if (pd.proctypeoption=bestpd.proctypeoption) and
((pd.procoptions*[po_classmethod,po_methodpointer])=(bestpd.procoptions*[po_classmethod,po_methodpointer])) and
(compare_paras(pd.paras,bestpd.paras,cp_all,[cpo_ignorehidden,cpo_ignoreuniv,cpo_openequalisexact])=te_exact) then
begin
{ first one encountered is closest in terms of visibility }
bestpd:=pd;
break;
end;
end;
end;
result:=cntpd;
end;
{$endif}
procedure tcallcandidates.find_wrong_para;
var
currparanr : smallint;

View File

@ -865,6 +865,9 @@ interface
a routine that has to be internally generated by the compiler }
synthetickind: tsynthetickind;
visibility : tvisibility;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
seenmarker : pointer; // used for filtering in tcandidate
{$endif}
constructor create(level:byte;doregister:boolean);virtual;
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
@ -6103,6 +6106,9 @@ implementation
{$else symansistr}
_mangledname:=nil;
{$endif symansistr}
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
seenmarker := nil;
{$endif}
fileinfo:=current_filepos;
extnumber:=$ffff;
aliasnames:=TCmdStrList.create;
@ -6795,10 +6801,17 @@ implementation
function tprocdef.defaultmangledname: TSymStr;
var
n : TSymStr;
begin
n:=procsym.name;
{ make sure that the mangled names of these overloadable methods types is
unique even if it's made lowercase (e.g. for section names) }
if proctypeoption in [potype_operator,potype_class_constructor,potype_class_destructor] then
n:='$'+n;
{ we need to use the symtable where the procsym is inserted,
because that is visible to the world }
defaultmangledname:=make_mangledname('',procsym.owner,procsym.name);
defaultmangledname:=make_mangledname('',procsym.owner,n);
defaultmangledname:=defaultmangledname+mangledprocparanames(Length(defaultmangledname))
end;

28
tests/tbs/tb0679.pp Normal file
View File

@ -0,0 +1,28 @@
{ %NORUN }
program tb0679;
{$mode objfpc}
type
TA = class
public
class destructor Destroy;
destructor Destroy; override;
end;
class destructor TA.Destroy;
begin
end;
destructor TA.Destroy;
begin
inherited;
end;
var
A: TA;
begin
A := TA.Create;
A.Free;
end.

26
tests/tbs/tb0680.pp Normal file
View File

@ -0,0 +1,26 @@
{ %NORUN }
program tb0680;
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
type
TTest = record
class operator + (aLeft, aRight: TTest): TTest;
function Plus(aLeft, aRight: TTest): TTest;
end;
class operator TTest.+(aLeft, aRight: TTest): TTest;
begin
end;
function TTest.Plus(aLeft, aRight: TTest): TTest;
begin
end;
begin
end.