mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 05:08:06 +02:00
* synchronized with trunk
git-svn-id: branches/wasm@47112 -
This commit is contained in:
commit
b4cdebeda3
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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
28
tests/tbs/tb0679.pp
Normal 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
26
tests/tbs/tb0680.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user