mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 15:47:52 +02:00
compiler:
- postpone insertion of hidden params into record methods after the full record parse to prevent interface and implementation difference because of the possible record size change after the method parse (issue #0021044) - skip hidden arguments during methods search for a property setter because of the above change and also for consistency with getter method search - test git-svn-id: trunk@20161 -
This commit is contained in:
paul
parent
c8ff351634
commit
d752ce2c11
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -12168,6 +12168,7 @@ tests/webtbs/tw20995a.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw20995b.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw20998.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw21029.pp svneol=native#text/plain
|
||||
tests/webtbs/tw21044.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw21073.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2109.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2110.pp svneol=native#text/plain
|
||||
|
||||
@ -48,6 +48,15 @@ interface
|
||||
);
|
||||
tpdflags=set of tpdflag;
|
||||
|
||||
// flags of handle_calling_convention routine
|
||||
thccflag=(
|
||||
hcc_check, // perform checks and outup errors if found
|
||||
hcc_insert_hidden_paras // insert hidden parameters
|
||||
);
|
||||
thccflags=set of thccflag;
|
||||
const
|
||||
hcc_all=[hcc_check,hcc_insert_hidden_paras];
|
||||
|
||||
function check_proc_directive(isprocvar:boolean):boolean;
|
||||
|
||||
procedure insert_funcret_local(pd:tprocdef);
|
||||
@ -56,7 +65,7 @@ interface
|
||||
function proc_get_importname(pd:tprocdef):string;
|
||||
procedure proc_set_mangledname(pd:tprocdef);
|
||||
|
||||
procedure handle_calling_convention(pd:tabstractprocdef);
|
||||
procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
|
||||
|
||||
procedure parse_parameter_dec(pd:tabstractprocdef);
|
||||
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
|
||||
@ -2839,104 +2848,110 @@ const
|
||||
end;
|
||||
|
||||
|
||||
procedure handle_calling_convention(pd:tabstractprocdef);
|
||||
procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
|
||||
begin
|
||||
{ set the default calling convention if none provided }
|
||||
if (pd.typ=procdef) and
|
||||
(is_objc_class_or_protocol(tprocdef(pd).struct) or
|
||||
is_cppclass(tprocdef(pd).struct)) then
|
||||
if hcc_check in flags then
|
||||
begin
|
||||
{ none of the explicit calling conventions should be allowed }
|
||||
if (po_hascallingconvention in pd.procoptions) then
|
||||
internalerror(2009032501);
|
||||
if is_cppclass(tprocdef(pd).struct) then
|
||||
pd.proccalloption:=pocall_cppdecl
|
||||
{ set the default calling convention if none provided }
|
||||
if (pd.typ=procdef) and
|
||||
(is_objc_class_or_protocol(tprocdef(pd).struct) or
|
||||
is_cppclass(tprocdef(pd).struct)) then
|
||||
begin
|
||||
{ none of the explicit calling conventions should be allowed }
|
||||
if (po_hascallingconvention in pd.procoptions) then
|
||||
internalerror(2009032501);
|
||||
if is_cppclass(tprocdef(pd).struct) then
|
||||
pd.proccalloption:=pocall_cppdecl
|
||||
else
|
||||
pd.proccalloption:=pocall_cdecl;
|
||||
end
|
||||
else if not(po_hascallingconvention in pd.procoptions) then
|
||||
pd.proccalloption:=current_settings.defproccall
|
||||
else
|
||||
pd.proccalloption:=pocall_cdecl;
|
||||
end
|
||||
else if not(po_hascallingconvention in pd.procoptions) then
|
||||
pd.proccalloption:=current_settings.defproccall
|
||||
else
|
||||
begin
|
||||
if pd.proccalloption=pocall_none then
|
||||
internalerror(200309081);
|
||||
begin
|
||||
if pd.proccalloption=pocall_none then
|
||||
internalerror(200309081);
|
||||
end;
|
||||
|
||||
{ handle proccall specific settings }
|
||||
case pd.proccalloption of
|
||||
pocall_cdecl,
|
||||
pocall_cppdecl :
|
||||
begin
|
||||
{ check C cdecl para types }
|
||||
check_c_para(pd);
|
||||
end;
|
||||
pocall_far16 :
|
||||
begin
|
||||
{ Temporary stub, must be rewritten to support OS/2 far16 }
|
||||
Message1(parser_w_proc_directive_ignored,'FAR16');
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Inlining is enabled and supported? }
|
||||
if (po_inline in pd.procoptions) and
|
||||
not(cs_do_inline in current_settings.localswitches) then
|
||||
begin
|
||||
{ Give an error if inline is not supported by the compiler mode,
|
||||
otherwise only give a warning that this procedure will not be inlined }
|
||||
if not(m_default_inline in current_settings.modeswitches) then
|
||||
Message(parser_e_proc_inline_not_supported)
|
||||
else
|
||||
Message(parser_w_inlining_disabled);
|
||||
exclude(pd.procoptions,po_inline);
|
||||
end;
|
||||
|
||||
{ For varargs directive also cdecl and external must be defined }
|
||||
if (po_varargs in pd.procoptions) then
|
||||
begin
|
||||
{ check first for external in the interface, if available there
|
||||
then the cdecl must also be there since there is no implementation
|
||||
available to contain it }
|
||||
if parse_only then
|
||||
begin
|
||||
{ if external is available, then cdecl must also be available,
|
||||
procvars don't need external }
|
||||
if not((po_external in pd.procoptions) or
|
||||
(pd.typ=procvardef) or
|
||||
{ for objcclasses this is checked later, because the entire
|
||||
class may be external. }
|
||||
is_objc_class_or_protocol(tprocdef(pd).struct)) and
|
||||
not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
|
||||
Message(parser_e_varargs_need_cdecl_and_external);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ both must be defined now }
|
||||
if not((po_external in pd.procoptions) or
|
||||
(pd.typ=procvardef)) or
|
||||
not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
|
||||
Message(parser_e_varargs_need_cdecl_and_external);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ handle proccall specific settings }
|
||||
case pd.proccalloption of
|
||||
pocall_cdecl,
|
||||
pocall_cppdecl :
|
||||
begin
|
||||
{ check C cdecl para types }
|
||||
check_c_para(pd);
|
||||
end;
|
||||
pocall_far16 :
|
||||
begin
|
||||
{ Temporary stub, must be rewritten to support OS/2 far16 }
|
||||
Message1(parser_w_proc_directive_ignored,'FAR16');
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Inlining is enabled and supported? }
|
||||
if (po_inline in pd.procoptions) and
|
||||
not(cs_do_inline in current_settings.localswitches) then
|
||||
if hcc_insert_hidden_paras in flags then
|
||||
begin
|
||||
{ Give an error if inline is not supported by the compiler mode,
|
||||
otherwise only give a warning that this procedure will not be inlined }
|
||||
if not(m_default_inline in current_settings.modeswitches) then
|
||||
Message(parser_e_proc_inline_not_supported)
|
||||
else
|
||||
Message(parser_w_inlining_disabled);
|
||||
exclude(pd.procoptions,po_inline);
|
||||
{ insert hidden high parameters }
|
||||
pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
|
||||
|
||||
{ insert hidden self parameter }
|
||||
insert_self_and_vmt_para(pd);
|
||||
|
||||
{ insert funcret parameter if required }
|
||||
insert_funcret_para(pd);
|
||||
|
||||
{ Make var parameters regable, this must be done after the calling
|
||||
convention is set. }
|
||||
{ this must be done before parentfp is insert, because getting all cases
|
||||
where parentfp must be in a memory location isn't catched properly so
|
||||
we put parentfp never in a register }
|
||||
pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
|
||||
|
||||
{ insert parentfp parameter if required }
|
||||
insert_parentfp_para(pd);
|
||||
end;
|
||||
|
||||
{ For varargs directive also cdecl and external must be defined }
|
||||
if (po_varargs in pd.procoptions) then
|
||||
begin
|
||||
{ check first for external in the interface, if available there
|
||||
then the cdecl must also be there since there is no implementation
|
||||
available to contain it }
|
||||
if parse_only then
|
||||
begin
|
||||
{ if external is available, then cdecl must also be available,
|
||||
procvars don't need external }
|
||||
if not((po_external in pd.procoptions) or
|
||||
(pd.typ=procvardef) or
|
||||
{ for objcclasses this is checked later, because the entire
|
||||
class may be external. }
|
||||
is_objc_class_or_protocol(tprocdef(pd).struct)) and
|
||||
not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
|
||||
Message(parser_e_varargs_need_cdecl_and_external);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ both must be defined now }
|
||||
if not((po_external in pd.procoptions) or
|
||||
(pd.typ=procvardef)) or
|
||||
not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
|
||||
Message(parser_e_varargs_need_cdecl_and_external);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ insert hidden high parameters }
|
||||
pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
|
||||
|
||||
{ insert hidden self parameter }
|
||||
insert_self_and_vmt_para(pd);
|
||||
|
||||
{ insert funcret parameter if required }
|
||||
insert_funcret_para(pd);
|
||||
|
||||
{ Make var parameters regable, this must be done after the calling
|
||||
convention is set. }
|
||||
{ this must be done before parentfp is insert, because getting all cases
|
||||
where parentfp must be in a memory location isn't catched properly so
|
||||
we put parentfp never in a register }
|
||||
pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
|
||||
|
||||
{ insert parentfp parameter if required }
|
||||
insert_parentfp_para(pd);
|
||||
|
||||
{ Calculate parameter tlist }
|
||||
pd.calcparas;
|
||||
end;
|
||||
|
||||
@ -602,11 +602,17 @@ implementation
|
||||
{ Insert hidden parameters }
|
||||
handle_calling_convention(writeprocdef);
|
||||
{ search procdefs matching writeprocdef }
|
||||
{ skip hidden part (same as for _READ part ) because of the }
|
||||
{ possible different calling conventions and especialy for }
|
||||
{ records - their methods hidden parameters are handled }
|
||||
{ after the full record parse }
|
||||
if cs_varpropsetter in current_settings.localswitches then
|
||||
p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults,cpo_ignorevarspez])
|
||||
p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults,cpo_ignorevarspez,cpo_ignorehidden])
|
||||
else
|
||||
p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]);
|
||||
if not assigned(p.propaccesslist[palt_write].procdef) then
|
||||
p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
|
||||
if not assigned(p.propaccesslist[palt_write].procdef) or
|
||||
{ because of cpo_ignorehidden we need to compare if it is a static class method and we have a class property }
|
||||
((sp_static in p.symoptions) <> tprocdef(p.propaccesslist[palt_write].procdef).no_self_node) then
|
||||
Message(parser_e_ill_property_access_sym);
|
||||
end;
|
||||
fieldvarsym :
|
||||
|
||||
@ -402,7 +402,7 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure parse_record_members;
|
||||
procedure parse_record_members(procdeflist:TFPObjectList);
|
||||
|
||||
procedure maybe_parse_hint_directives(pd:tprocdef);
|
||||
var
|
||||
@ -548,7 +548,9 @@ implementation
|
||||
begin
|
||||
parse_record_proc_directives(pd);
|
||||
|
||||
handle_calling_convention(pd);
|
||||
// postpone adding hidden params
|
||||
handle_calling_convention(pd,[hcc_check]);
|
||||
procdeflist.add(pd);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(pd);
|
||||
@ -618,7 +620,11 @@ implementation
|
||||
if is_classdef and not (po_staticmethod in pd.procoptions) then
|
||||
MessagePos(pd.fileinfo, parser_e_class_methods_only_static_in_records);
|
||||
|
||||
handle_calling_convention(pd);
|
||||
// we can't add hidden params here because record is not yet defined
|
||||
// and therefore record size which has influence on paramter passing rules may change too
|
||||
// look at record_dec to see where calling conventions are applied (issue #0021044)
|
||||
handle_calling_convention(pd,[hcc_check]);
|
||||
procdeflist.add(pd);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(pd);
|
||||
@ -705,6 +711,11 @@ implementation
|
||||
old_current_specializedef: tstoreddef;
|
||||
old_parse_generic: boolean;
|
||||
recst: trecordsymtable;
|
||||
procdeflist: TFPObjectList;
|
||||
i: integer;
|
||||
pd: tprocdef;
|
||||
oldparse_only: boolean;
|
||||
oldpos : tfileposinfo;
|
||||
begin
|
||||
old_current_structdef:=current_structdef;
|
||||
old_current_genericdef:=current_genericdef;
|
||||
@ -739,7 +750,23 @@ implementation
|
||||
include(current_structdef.defoptions, df_generic);
|
||||
parse_generic:=(df_generic in current_structdef.defoptions);
|
||||
if m_advanced_records in current_settings.modeswitches then
|
||||
parse_record_members
|
||||
begin
|
||||
procdeflist:=TFPObjectList.Create(false);
|
||||
parse_record_members(procdeflist);
|
||||
// handle calling conventions of record methods
|
||||
oldpos:=current_filepos;
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
for i := 0 to procdeflist.count - 1 do
|
||||
begin
|
||||
pd:=tprocdef(procdeflist[i]);
|
||||
current_filepos:=pd.fileinfo;
|
||||
handle_calling_convention(pd,[hcc_insert_hidden_paras]);
|
||||
end;
|
||||
parse_only:=oldparse_only;
|
||||
current_filepos:=oldpos;
|
||||
procdeflist.free;
|
||||
end
|
||||
else
|
||||
begin
|
||||
read_record_fields([vd_record]);
|
||||
|
||||
37
tests/webtbs/tw21044.pp
Normal file
37
tests/webtbs/tw21044.pp
Normal file
@ -0,0 +1,37 @@
|
||||
{ %norun}
|
||||
program tw21044;
|
||||
|
||||
{$mode Delphi}
|
||||
|
||||
uses
|
||||
SysUtils, Classes;
|
||||
|
||||
type
|
||||
{ TTestRecord }
|
||||
|
||||
TTestRecord = record
|
||||
public
|
||||
function Test(const Lhs, Rhs: TTestRecord): TTestRecord;
|
||||
// operator overloads
|
||||
class operator Add(const Lhs, Rhs: TTestRecord): TTestRecord;
|
||||
// this part changes the size of record and so the way of parameter handling
|
||||
// on some 64bit systems
|
||||
case Boolean of
|
||||
False: (Value: Single);
|
||||
True: (AsInteger: Integer);
|
||||
end;
|
||||
|
||||
{ TTestRecord }
|
||||
|
||||
function TTestRecord.Test(const Lhs, Rhs: TTestRecord): TTestRecord;
|
||||
begin
|
||||
Result.AsInteger := Lhs.AsInteger + Rhs.AsInteger;
|
||||
end;
|
||||
|
||||
class operator TTestRecord.Add(const Lhs, Rhs: TTestRecord): TTestRecord;
|
||||
begin
|
||||
Result.Value := Lhs.Value + Rhs.Value;
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user