mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-08 20:49:16 +02:00
* factored out associating properties with their getters/setters/fiels
o moved JVM-specific code from pdecvar (and pjvm) to jvm/symcpu git-svn-id: trunk@27938 -
This commit is contained in:
Jonas Maebe
parent
47c6b08ece
commit
2bd39f62cb
@ -48,13 +48,6 @@ interface
|
||||
|
||||
function jvm_wrap_method_with_vis(pd: tprocdef; vis: tvisibility): tprocdef;
|
||||
|
||||
{ when a private/protected field is exposed via a property with a higher
|
||||
visibility, then we have to create a getter and/or setter with that same
|
||||
higher visibility to make sure that using the property does not result
|
||||
in JVM verification errors }
|
||||
procedure jvm_create_getter_for_property(p: tpropertysym; orgaccesspd: tprocdef);
|
||||
procedure jvm_create_setter_for_property(p: tpropertysym; orgaccesspd: tprocdef);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
@ -853,287 +846,4 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure jvm_create_getter_or_setter_for_property(p: tpropertysym; orgaccesspd: tprocdef; getter: boolean);
|
||||
var
|
||||
obj: tabstractrecorddef;
|
||||
ps: tprocsym;
|
||||
pvs: tparavarsym;
|
||||
sym: tsym;
|
||||
pd, parentpd, accessorparapd: tprocdef;
|
||||
tmpaccesslist: tpropaccesslist;
|
||||
callthroughpropname,
|
||||
name: string;
|
||||
callthroughprop: tpropertysym;
|
||||
accesstyp: tpropaccesslisttypes;
|
||||
sktype: tsynthetickind;
|
||||
procoptions: tprocoptions;
|
||||
paranr: word;
|
||||
explicitwrapper: boolean;
|
||||
begin
|
||||
obj:=current_structdef;
|
||||
{ if someone gets the idea to add a property to an external class
|
||||
definition, don't try to wrap it since we cannot add methods to
|
||||
external classes }
|
||||
if oo_is_external in obj.objectoptions then
|
||||
exit;
|
||||
symtablestack.push(obj.symtable);
|
||||
|
||||
try
|
||||
if getter then
|
||||
accesstyp:=palt_read
|
||||
else
|
||||
accesstyp:=palt_write;
|
||||
|
||||
{ we can't use str_parse_method_dec here because the type of the field
|
||||
may not be visible at the Pascal level }
|
||||
|
||||
explicitwrapper:=
|
||||
{ private methods are not visibile outside the current class, so
|
||||
no use in making life harder for us by introducing potential
|
||||
(future or current) naming conflicts }
|
||||
(p.visibility<>vis_private) and
|
||||
(getter and
|
||||
(prop_auto_getter_prefix<>'')) or
|
||||
(not getter and
|
||||
(prop_auto_setter_prefix<>''));
|
||||
sym:=nil;
|
||||
procoptions:=[];
|
||||
if explicitwrapper then
|
||||
begin
|
||||
if getter then
|
||||
name:=prop_auto_getter_prefix+p.realname
|
||||
else
|
||||
name:=prop_auto_setter_prefix+p.realname;
|
||||
sym:=search_struct_member_no_helper(obj,upper(name));
|
||||
if getter then
|
||||
sktype:=tsk_field_getter
|
||||
else
|
||||
sktype:=tsk_field_setter;
|
||||
if assigned(sym) then
|
||||
begin
|
||||
if ((sym.typ<>procsym) or
|
||||
(tprocsym(sym).procdeflist.count<>1) or
|
||||
(tprocdef(tprocsym(sym).procdeflist[0]).synthetickind<>sktype)) and
|
||||
(not assigned(orgaccesspd) or
|
||||
(sym<>orgaccesspd.procsym)) then
|
||||
begin
|
||||
MessagePos2(p.fileinfo,parser_e_cannot_generate_property_getter_setter,name,FullTypeName(tdef(sym.owner.defowner),nil)+'.'+name);
|
||||
exit;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if name<>sym.realname then
|
||||
MessagePos2(p.fileinfo,parser_w_case_difference_auto_property_getter_setter_prefix,sym.realname,name);
|
||||
{ is the specified getter/setter defined in the current
|
||||
struct and was it originally specified as the getter/
|
||||
setter for this property? If so, simply adjust its
|
||||
visibility if necessary.
|
||||
}
|
||||
if assigned(orgaccesspd) then
|
||||
parentpd:=orgaccesspd
|
||||
else
|
||||
parentpd:=tprocdef(tprocsym(sym).procdeflist[0]);
|
||||
if parentpd.owner.defowner=p.owner.defowner then
|
||||
begin
|
||||
if parentpd.visibility<p.visibility then
|
||||
begin
|
||||
parentpd.visibility:=p.visibility;
|
||||
include(parentpd.procoptions,po_auto_raised_visibility);
|
||||
end;
|
||||
{ we are done, no need to create a wrapper }
|
||||
exit
|
||||
end
|
||||
{ a parent already included this getter/setter -> try to
|
||||
override it }
|
||||
else if parentpd.visibility<>vis_private then
|
||||
begin
|
||||
if po_virtualmethod in parentpd.procoptions then
|
||||
begin
|
||||
procoptions:=procoptions+[po_virtualmethod,po_overridingmethod];
|
||||
Message2(parser_w_overriding_property_getter_setter,name,FullTypeName(tdef(parentpd.owner.defowner),nil));
|
||||
end;
|
||||
{ otherwise we can't do anything, and
|
||||
proc_add_definition will give an error }
|
||||
end;
|
||||
{ add method with the correct visibility }
|
||||
pd:=tprocdef(parentpd.getcopy);
|
||||
{ get rid of the import name for inherited virtual class methods,
|
||||
it has to be regenerated rather than amended }
|
||||
if [po_classmethod,po_virtualmethod]<=pd.procoptions then
|
||||
begin
|
||||
stringdispose(pd.import_name);
|
||||
exclude(pd.procoptions,po_has_importname);
|
||||
end;
|
||||
pd.visibility:=p.visibility;
|
||||
pd.procoptions:=pd.procoptions+procoptions;
|
||||
{ ignore this artificially added procdef when looking for overloads }
|
||||
include(pd.procoptions,po_ignore_for_overload_resolution);
|
||||
finish_copied_procdef(pd,parentpd.procsym.realname,obj.symtable,obj);
|
||||
exclude(pd.procoptions,po_external);
|
||||
pd.synthetickind:=tsk_anon_inherited;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
{ make the artificial getter/setter virtual so we can override it in
|
||||
children if necessary }
|
||||
if not(sp_static in p.symoptions) and
|
||||
(obj.typ=objectdef) then
|
||||
include(procoptions,po_virtualmethod);
|
||||
{ prevent problems in Delphi mode }
|
||||
include(procoptions,po_overload);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ construct procsym name (unique for this access; reusing the same
|
||||
helper for multiple accesses to the same field is hard because the
|
||||
propacesslist can contain subscript nodes etc) }
|
||||
name:=visibilityName[p.visibility];
|
||||
replace(name,' ','_');
|
||||
if getter then
|
||||
name:=name+'$getter'
|
||||
else
|
||||
name:=name+'$setter';
|
||||
end;
|
||||
|
||||
{ create procdef }
|
||||
if not assigned(orgaccesspd) then
|
||||
begin
|
||||
pd:=cprocdef.create(normal_function_level);
|
||||
if df_generic in obj.defoptions then
|
||||
include(pd.defoptions,df_generic);
|
||||
{ method of this objectdef }
|
||||
pd.struct:=obj;
|
||||
{ can only construct the artificial name now, because it requires
|
||||
pd.defid }
|
||||
if not explicitwrapper then
|
||||
name:='$'+obj.symtable.realname^+'$'+p.realname+'$'+name+'$'+tostr(pd.defid);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ getter/setter could have parameters in case of indexed access
|
||||
-> copy original procdef }
|
||||
pd:=tprocdef(orgaccesspd.getcopy);
|
||||
exclude(pd.procoptions,po_abstractmethod);
|
||||
{ can only construct the artificial name now, because it requires
|
||||
pd.defid }
|
||||
if not explicitwrapper then
|
||||
name:='$'+obj.symtable.realname^+'$'+p.realname+'$'+name+'$'+tostr(pd.defid);
|
||||
finish_copied_procdef(pd,name,obj.symtable,obj);
|
||||
sym:=pd.procsym;
|
||||
end;
|
||||
{ add previously collected procoptions }
|
||||
pd.procoptions:=pd.procoptions+procoptions;
|
||||
{ visibility }
|
||||
pd.visibility:=p.visibility;
|
||||
|
||||
{ new procsym? }
|
||||
if not assigned(sym) or
|
||||
(sym.owner<>p.owner) then
|
||||
begin
|
||||
ps:=cprocsym.create(name);
|
||||
obj.symtable.insert(ps);
|
||||
end
|
||||
else
|
||||
ps:=tprocsym(sym);
|
||||
{ associate procsym with procdef}
|
||||
pd.procsym:=ps;
|
||||
|
||||
|
||||
|
||||
{ function/procedure }
|
||||
accessorparapd:=nil;
|
||||
if getter then
|
||||
begin
|
||||
pd.proctypeoption:=potype_function;
|
||||
pd.synthetickind:=tsk_field_getter;
|
||||
{ result type }
|
||||
pd.returndef:=p.propdef;
|
||||
if (ppo_hasparameters in p.propoptions) and
|
||||
not assigned(orgaccesspd) then
|
||||
accessorparapd:=pd;
|
||||
end
|
||||
else
|
||||
begin
|
||||
pd.proctypeoption:=potype_procedure;
|
||||
pd.synthetickind:=tsk_field_setter;
|
||||
pd.returndef:=voidtype;
|
||||
if not assigned(orgaccesspd) then
|
||||
begin
|
||||
{ parameter with value to set }
|
||||
pvs:=cparavarsym.create('__fpc_newval__',10,vs_const,p.propdef,[]);
|
||||
pd.parast.insert(pvs);
|
||||
end;
|
||||
if (ppo_hasparameters in p.propoptions) and
|
||||
not assigned(orgaccesspd) then
|
||||
accessorparapd:=pd;
|
||||
end;
|
||||
|
||||
{ create a property for the old symaccesslist with a new name, so that
|
||||
we can reuse it in the implementation (rather than having to
|
||||
translate the symaccesslist back to Pascal code) }
|
||||
callthroughpropname:='__fpc__'+p.realname;
|
||||
if getter then
|
||||
callthroughpropname:=callthroughpropname+'__getter_wrapper'
|
||||
else
|
||||
callthroughpropname:=callthroughpropname+'__setter_wrapper';
|
||||
callthroughprop:=cpropertysym.create(callthroughpropname);
|
||||
callthroughprop.visibility:=p.visibility;
|
||||
|
||||
if getter then
|
||||
p.makeduplicate(callthroughprop,accessorparapd,nil,paranr)
|
||||
else
|
||||
p.makeduplicate(callthroughprop,nil,accessorparapd,paranr);
|
||||
|
||||
callthroughprop.default:=longint($80000000);
|
||||
callthroughprop.default:=0;
|
||||
callthroughprop.propoptions:=callthroughprop.propoptions-[ppo_stored,ppo_enumerator_current,ppo_overrides,ppo_defaultproperty];
|
||||
if sp_static in p.symoptions then
|
||||
include(callthroughprop.symoptions, sp_static);
|
||||
{ copy original property target to callthrough property (and replace
|
||||
original one with the new empty list; will be filled in later) }
|
||||
tmpaccesslist:=callthroughprop.propaccesslist[accesstyp];
|
||||
callthroughprop.propaccesslist[accesstyp]:=p.propaccesslist[accesstyp];
|
||||
p.propaccesslist[accesstyp]:=tmpaccesslist;
|
||||
p.owner.insert(callthroughprop);
|
||||
|
||||
pd.skpara:=callthroughprop;
|
||||
{ needs to be exported }
|
||||
include(pd.procoptions,po_global);
|
||||
{ class property -> static class method }
|
||||
if sp_static in p.symoptions then
|
||||
pd.procoptions:=pd.procoptions+[po_classmethod,po_staticmethod];
|
||||
|
||||
{ in case we made a copy of the original accessor, this has all been
|
||||
done already }
|
||||
if not assigned(orgaccesspd) then
|
||||
begin
|
||||
{ calling convention, self, ... }
|
||||
if obj.typ=recorddef then
|
||||
handle_calling_convention(pd,[hcc_check])
|
||||
else
|
||||
handle_calling_convention(pd,hcc_all);
|
||||
{ register forward declaration with procsym }
|
||||
proc_add_definition(pd);
|
||||
end;
|
||||
|
||||
{ make the property call this new function }
|
||||
p.propaccesslist[accesstyp].addsym(sl_call,ps);
|
||||
p.propaccesslist[accesstyp].procdef:=pd;
|
||||
finally
|
||||
symtablestack.pop(obj.symtable);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure jvm_create_getter_for_property(p: tpropertysym; orgaccesspd: tprocdef);
|
||||
begin
|
||||
jvm_create_getter_or_setter_for_property(p,orgaccesspd,true);
|
||||
end;
|
||||
|
||||
|
||||
procedure jvm_create_setter_for_property(p: tpropertysym; orgaccesspd: tprocdef);
|
||||
begin
|
||||
jvm_create_getter_or_setter_for_property(p,orgaccesspd,false);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -182,6 +182,13 @@ type
|
||||
tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
|
||||
|
||||
tcpupropertysym = class(tpropertysym)
|
||||
protected
|
||||
{ when a private/protected field is exposed via a property with a higher
|
||||
visibility, then we have to create a getter and/or setter with that same
|
||||
higher visibility to make sure that using the property does not result
|
||||
in JVM verification errors }
|
||||
procedure create_getter_or_setter_for_property(orgaccesspd: tprocdef; getter: boolean);
|
||||
procedure finalize_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef); override;
|
||||
end;
|
||||
tcpupropertysymclass = class of tcpupropertysym;
|
||||
|
||||
@ -205,11 +212,334 @@ const
|
||||
implementation
|
||||
|
||||
uses
|
||||
verbose,cutils,cclasses,
|
||||
symconst,symbase,jvmdef,
|
||||
verbose,cutils,cclasses,globals,
|
||||
symconst,symbase,symtable,symcreat,jvmdef,
|
||||
pdecsub,pjvm,
|
||||
paramgr;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
tcpuproptertysym
|
||||
****************************************************************************}
|
||||
|
||||
procedure tcpupropertysym.create_getter_or_setter_for_property(orgaccesspd: tprocdef; getter: boolean);
|
||||
var
|
||||
obj: tabstractrecorddef;
|
||||
ps: tprocsym;
|
||||
pvs: tparavarsym;
|
||||
sym: tsym;
|
||||
pd, parentpd, accessorparapd: tprocdef;
|
||||
tmpaccesslist: tpropaccesslist;
|
||||
callthroughpropname,
|
||||
accessorname: string;
|
||||
callthroughprop: tpropertysym;
|
||||
accesstyp: tpropaccesslisttypes;
|
||||
sktype: tsynthetickind;
|
||||
procoptions: tprocoptions;
|
||||
paranr: word;
|
||||
explicitwrapper: boolean;
|
||||
begin
|
||||
obj:=current_structdef;
|
||||
{ if someone gets the idea to add a property to an external class
|
||||
definition, don't try to wrap it since we cannot add methods to
|
||||
external classes }
|
||||
if oo_is_external in obj.objectoptions then
|
||||
exit;
|
||||
symtablestack.push(obj.symtable);
|
||||
|
||||
try
|
||||
if getter then
|
||||
accesstyp:=palt_read
|
||||
else
|
||||
accesstyp:=palt_write;
|
||||
|
||||
{ we can't use str_parse_method_dec here because the type of the field
|
||||
may not be visible at the Pascal level }
|
||||
|
||||
explicitwrapper:=
|
||||
{ private methods are not visibile outside the current class, so
|
||||
no use in making life harder for us by introducing potential
|
||||
(future or current) naming conflicts }
|
||||
(visibility<>vis_private) and
|
||||
(getter and
|
||||
(prop_auto_getter_prefix<>'')) or
|
||||
(not getter and
|
||||
(prop_auto_setter_prefix<>''));
|
||||
sym:=nil;
|
||||
procoptions:=[];
|
||||
if explicitwrapper then
|
||||
begin
|
||||
if getter then
|
||||
accessorname:=prop_auto_getter_prefix+realname
|
||||
else
|
||||
accessorname:=prop_auto_setter_prefix+realname;
|
||||
sym:=search_struct_member_no_helper(obj,upper(accessorname));
|
||||
if getter then
|
||||
sktype:=tsk_field_getter
|
||||
else
|
||||
sktype:=tsk_field_setter;
|
||||
if assigned(sym) then
|
||||
begin
|
||||
if ((sym.typ<>procsym) or
|
||||
(tprocsym(sym).procdeflist.count<>1) or
|
||||
(tprocdef(tprocsym(sym).procdeflist[0]).synthetickind<>sktype)) and
|
||||
(not assigned(orgaccesspd) or
|
||||
(sym<>orgaccesspd.procsym)) then
|
||||
begin
|
||||
MessagePos2(fileinfo,parser_e_cannot_generate_property_getter_setter,accessorname,FullTypeName(tdef(sym.owner.defowner),nil)+'.'+accessorname);
|
||||
exit;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if accessorname<>sym.realname then
|
||||
MessagePos2(fileinfo,parser_w_case_difference_auto_property_getter_setter_prefix,sym.realname,accessorname);
|
||||
{ is the specified getter/setter defined in the current
|
||||
struct and was it originally specified as the getter/
|
||||
setter for this property? If so, simply adjust its
|
||||
visibility if necessary.
|
||||
}
|
||||
if assigned(orgaccesspd) then
|
||||
parentpd:=orgaccesspd
|
||||
else
|
||||
parentpd:=tprocdef(tprocsym(sym).procdeflist[0]);
|
||||
if parentpd.owner.defowner=owner.defowner then
|
||||
begin
|
||||
if parentpd.visibility<visibility then
|
||||
begin
|
||||
parentpd.visibility:=visibility;
|
||||
include(parentpd.procoptions,po_auto_raised_visibility);
|
||||
end;
|
||||
{ we are done, no need to create a wrapper }
|
||||
exit
|
||||
end
|
||||
{ a parent already included this getter/setter -> try to
|
||||
override it }
|
||||
else if parentpd.visibility<>vis_private then
|
||||
begin
|
||||
if po_virtualmethod in parentpd.procoptions then
|
||||
begin
|
||||
procoptions:=procoptions+[po_virtualmethod,po_overridingmethod];
|
||||
Message2(parser_w_overriding_property_getter_setter,accessorname,FullTypeName(tdef(parentpd.owner.defowner),nil));
|
||||
end;
|
||||
{ otherwise we can't do anything, and
|
||||
proc_add_definition will give an error }
|
||||
end;
|
||||
{ add method with the correct visibility }
|
||||
pd:=tprocdef(parentpd.getcopy);
|
||||
{ get rid of the import accessorname for inherited virtual class methods,
|
||||
it has to be regenerated rather than amended }
|
||||
if [po_classmethod,po_virtualmethod]<=pd.procoptions then
|
||||
begin
|
||||
stringdispose(pd.import_name);
|
||||
exclude(pd.procoptions,po_has_importname);
|
||||
end;
|
||||
pd.visibility:=visibility;
|
||||
pd.procoptions:=pd.procoptions+procoptions;
|
||||
{ ignore this artificially added procdef when looking for overloads }
|
||||
include(pd.procoptions,po_ignore_for_overload_resolution);
|
||||
finish_copied_procdef(pd,parentpd.procsym.realname,obj.symtable,obj);
|
||||
exclude(pd.procoptions,po_external);
|
||||
pd.synthetickind:=tsk_anon_inherited;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
{ make the artificial getter/setter virtual so we can override it in
|
||||
children if necessary }
|
||||
if not(sp_static in symoptions) and
|
||||
(obj.typ=objectdef) then
|
||||
include(procoptions,po_virtualmethod);
|
||||
{ prevent problems in Delphi mode }
|
||||
include(procoptions,po_overload);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ construct procsym accessorname (unique for this access; reusing the same
|
||||
helper for multiple accesses to the same field is hard because the
|
||||
propacesslist can contain subscript nodes etc) }
|
||||
accessorname:=visibilityName[visibility];
|
||||
replace(accessorname,' ','_');
|
||||
if getter then
|
||||
accessorname:=accessorname+'$getter'
|
||||
else
|
||||
accessorname:=accessorname+'$setter';
|
||||
end;
|
||||
|
||||
{ create procdef }
|
||||
if not assigned(orgaccesspd) then
|
||||
begin
|
||||
pd:=cprocdef.create(normal_function_level);
|
||||
if df_generic in obj.defoptions then
|
||||
include(pd.defoptions,df_generic);
|
||||
{ method of this objectdef }
|
||||
pd.struct:=obj;
|
||||
{ can only construct the artificial accessorname now, because it requires
|
||||
pd.defid }
|
||||
if not explicitwrapper then
|
||||
accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+tostr(pd.defid);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ getter/setter could have parameters in case of indexed access
|
||||
-> copy original procdef }
|
||||
pd:=tprocdef(orgaccesspd.getcopy);
|
||||
exclude(pd.procoptions,po_abstractmethod);
|
||||
{ can only construct the artificial accessorname now, because it requires
|
||||
pd.defid }
|
||||
if not explicitwrapper then
|
||||
accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+tostr(pd.defid);
|
||||
finish_copied_procdef(pd,accessorname,obj.symtable,obj);
|
||||
sym:=pd.procsym;
|
||||
end;
|
||||
{ add previously collected procoptions }
|
||||
pd.procoptions:=pd.procoptions+procoptions;
|
||||
{ visibility }
|
||||
pd.visibility:=visibility;
|
||||
|
||||
{ new procsym? }
|
||||
if not assigned(sym) or
|
||||
(sym.owner<>owner) then
|
||||
begin
|
||||
ps:=cprocsym.create(accessorname);
|
||||
obj.symtable.insert(ps);
|
||||
end
|
||||
else
|
||||
ps:=tprocsym(sym);
|
||||
{ associate procsym with procdef}
|
||||
pd.procsym:=ps;
|
||||
|
||||
|
||||
|
||||
{ function/procedure }
|
||||
accessorparapd:=nil;
|
||||
if getter then
|
||||
begin
|
||||
pd.proctypeoption:=potype_function;
|
||||
pd.synthetickind:=tsk_field_getter;
|
||||
{ result type }
|
||||
pd.returndef:=propdef;
|
||||
if (ppo_hasparameters in propoptions) and
|
||||
not assigned(orgaccesspd) then
|
||||
accessorparapd:=pd;
|
||||
end
|
||||
else
|
||||
begin
|
||||
pd.proctypeoption:=potype_procedure;
|
||||
pd.synthetickind:=tsk_field_setter;
|
||||
pd.returndef:=voidtype;
|
||||
if not assigned(orgaccesspd) then
|
||||
begin
|
||||
{ parameter with value to set }
|
||||
pvs:=cparavarsym.create('__fpc_newval__',10,vs_const,propdef,[]);
|
||||
pd.parast.insert(pvs);
|
||||
end;
|
||||
if (ppo_hasparameters in propoptions) and
|
||||
not assigned(orgaccesspd) then
|
||||
accessorparapd:=pd;
|
||||
end;
|
||||
|
||||
{ create a property for the old symaccesslist with a new accessorname, so that
|
||||
we can reuse it in the implementation (rather than having to
|
||||
translate the symaccesslist back to Pascal code) }
|
||||
callthroughpropname:='__fpc__'+realname;
|
||||
if getter then
|
||||
callthroughpropname:=callthroughpropname+'__getter_wrapper'
|
||||
else
|
||||
callthroughpropname:=callthroughpropname+'__setter_wrapper';
|
||||
callthroughprop:=cpropertysym.create(callthroughpropname);
|
||||
callthroughprop.visibility:=visibility;
|
||||
|
||||
if getter then
|
||||
makeduplicate(callthroughprop,accessorparapd,nil,paranr)
|
||||
else
|
||||
makeduplicate(callthroughprop,nil,accessorparapd,paranr);
|
||||
|
||||
callthroughprop.default:=longint($80000000);
|
||||
callthroughprop.default:=0;
|
||||
callthroughprop.propoptions:=callthroughprop.propoptions-[ppo_stored,ppo_enumerator_current,ppo_overrides,ppo_defaultproperty];
|
||||
if sp_static in symoptions then
|
||||
include(callthroughprop.symoptions, sp_static);
|
||||
{ copy original property target to callthrough property (and replace
|
||||
original one with the new empty list; will be filled in later) }
|
||||
tmpaccesslist:=callthroughprop.propaccesslist[accesstyp];
|
||||
callthroughprop.propaccesslist[accesstyp]:=propaccesslist[accesstyp];
|
||||
propaccesslist[accesstyp]:=tmpaccesslist;
|
||||
owner.insert(callthroughprop);
|
||||
|
||||
pd.skpara:=callthroughprop;
|
||||
{ needs to be exported }
|
||||
include(pd.procoptions,po_global);
|
||||
{ class property -> static class method }
|
||||
if sp_static in symoptions then
|
||||
pd.procoptions:=pd.procoptions+[po_classmethod,po_staticmethod];
|
||||
|
||||
{ in case we made a copy of the original accessor, this has all been
|
||||
done already }
|
||||
if not assigned(orgaccesspd) then
|
||||
begin
|
||||
{ calling convention, self, ... }
|
||||
if obj.typ=recorddef then
|
||||
handle_calling_convention(pd,[hcc_check])
|
||||
else
|
||||
handle_calling_convention(pd,hcc_all);
|
||||
{ register forward declaration with procsym }
|
||||
proc_add_definition(pd);
|
||||
end;
|
||||
|
||||
{ make the property call this new function }
|
||||
propaccesslist[accesstyp].addsym(sl_call,ps);
|
||||
propaccesslist[accesstyp].procdef:=pd;
|
||||
finally
|
||||
symtablestack.pop(obj.symtable);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tcpupropertysym.finalize_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef);
|
||||
var
|
||||
orgaccesspd: tprocdef;
|
||||
pprefix: pstring;
|
||||
wrongvisibility: boolean;
|
||||
begin
|
||||
inherited;
|
||||
if getset=palt_read then
|
||||
pprefix:=@prop_auto_getter_prefix
|
||||
else
|
||||
pprefix:=@prop_auto_setter_prefix;
|
||||
case sym.typ of
|
||||
procsym:
|
||||
begin
|
||||
orgaccesspd:=tprocdef(propaccesslist[getset].procdef);
|
||||
wrongvisibility:=tprocdef(propaccesslist[getset].procdef).visibility<visibility;
|
||||
if (pprefix^<>'') and
|
||||
(wrongvisibility or
|
||||
(sym.RealName<>pprefix^+RealName)) then
|
||||
create_getter_or_setter_for_property(orgaccesspd,getset=palt_read)
|
||||
{ if the visibility of the accessor is lower than
|
||||
the visibility of the property, wrap it so that
|
||||
we can call it from all contexts in which the
|
||||
property is visible }
|
||||
else if wrongvisibility then
|
||||
begin
|
||||
propaccesslist[getset].procdef:=jvm_wrap_method_with_vis(tprocdef(propaccesslist[palt_read].procdef),visibility);
|
||||
propaccesslist[getset].firstsym^.sym:=tprocdef(propaccesslist[getset].procdef).procsym;
|
||||
end;
|
||||
end;
|
||||
fieldvarsym:
|
||||
begin
|
||||
{ if the visibility of the field is lower than the
|
||||
visibility of the property, wrap it in a getter
|
||||
so that we can access it from all contexts in
|
||||
which the property is visibile }
|
||||
if (pprefix^<>'') or
|
||||
(tfieldvarsym(sym).visibility<visibility) then
|
||||
create_getter_or_setter_for_property(nil,getset=palt_read);
|
||||
end;
|
||||
else
|
||||
internalerror(2014061101);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
tcpuenumdef
|
||||
****************************************************************************}
|
||||
|
||||
@ -520,79 +520,21 @@ implementation
|
||||
|
||||
if not(is_dispinterface(astruct)) then
|
||||
begin
|
||||
{ parse accessors }
|
||||
if try_to_consume(_READ) then
|
||||
begin
|
||||
p.propaccesslist[palt_read].clear;
|
||||
if parse_symlist(p.propaccesslist[palt_read],def) then
|
||||
begin
|
||||
sym:=p.propaccesslist[palt_read].firstsym^.sym;
|
||||
case sym.typ of
|
||||
procsym :
|
||||
begin
|
||||
{ read is function returning the type of the property }
|
||||
readprocdef.returndef:=p.propdef;
|
||||
{ Insert hidden parameters }
|
||||
handle_calling_convention(readprocdef);
|
||||
{ search procdefs matching readprocdef }
|
||||
{ we ignore hidden stuff here because the property access symbol might have
|
||||
non default calling conventions which might change the hidden stuff;
|
||||
see tw3216.pp (FK) }
|
||||
p.propaccesslist[palt_read].procdef:=Tprocsym(sym).Find_procdef_bypara(readprocdef.paras,p.propdef,[cpo_allowdefaults,cpo_ignorehidden]);
|
||||
if not assigned(p.propaccesslist[palt_read].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_read].procdef).no_self_node) then
|
||||
Message(parser_e_ill_property_access_sym)
|
||||
else
|
||||
begin
|
||||
{$ifdef jvm}
|
||||
orgaccesspd:=tprocdef(p.propaccesslist[palt_read].procdef);
|
||||
wrongvisibility:=tprocdef(p.propaccesslist[palt_read].procdef).visibility<p.visibility;
|
||||
if (prop_auto_getter_prefix<>'') and
|
||||
(wrongvisibility or
|
||||
(p.propaccesslist[palt_read].firstsym^.sym.RealName<>prop_auto_getter_prefix+p.RealName)) then
|
||||
jvm_create_getter_for_property(p,orgaccesspd)
|
||||
{ if the visibility of the getter is lower than
|
||||
the visibility of the property, wrap it so that
|
||||
we can call it from all contexts in which the
|
||||
property is visible }
|
||||
else if wrongvisibility then
|
||||
begin
|
||||
p.propaccesslist[palt_read].procdef:=jvm_wrap_method_with_vis(tprocdef(p.propaccesslist[palt_read].procdef),p.visibility);
|
||||
p.propaccesslist[palt_read].firstsym^.sym:=tprocdef(p.propaccesslist[palt_read].procdef).procsym;
|
||||
end;
|
||||
{$endif jvm}
|
||||
end;
|
||||
end;
|
||||
fieldvarsym :
|
||||
begin
|
||||
if not assigned(def) then
|
||||
internalerror(200310071);
|
||||
if compare_defs(def,p.propdef,nothingn)>=te_equal then
|
||||
begin
|
||||
{ property parameters are allowed if this is
|
||||
an indexed property, because the index is then
|
||||
the parameter.
|
||||
Note: In the help of Kylix it is written
|
||||
that it isn't allowed, but the compiler accepts it (PFV) }
|
||||
if (ppo_hasparameters in p.propoptions) or
|
||||
((sp_static in p.symoptions) <> (sp_static in sym.symoptions)) then
|
||||
Message(parser_e_ill_property_access_sym);
|
||||
{$ifdef jvm}
|
||||
{ if the visibility of the field is lower than the
|
||||
visibility of the property, wrap it in a getter
|
||||
so that we can access it from all contexts in
|
||||
which the property is visibile }
|
||||
if (prop_auto_getter_prefix<>'') or
|
||||
(tfieldvarsym(sym).visibility<p.visibility) then
|
||||
jvm_create_getter_for_property(p,nil);
|
||||
{$endif}
|
||||
end
|
||||
else
|
||||
IncompatibleTypes(def,p.propdef);
|
||||
end;
|
||||
else
|
||||
Message(parser_e_ill_property_access_sym);
|
||||
end;
|
||||
{ getter is a function returning the type of the property }
|
||||
if sym.typ=procsym then
|
||||
begin
|
||||
readprocdef.returndef:=p.propdef;
|
||||
{ Insert hidden parameters }
|
||||
handle_calling_convention(readprocdef);
|
||||
end;
|
||||
p.add_getter_or_setter_for_sym(palt_read,sym,def,readprocdef);
|
||||
end;
|
||||
end;
|
||||
if try_to_consume(_WRITE) then
|
||||
@ -601,81 +543,18 @@ implementation
|
||||
if parse_symlist(p.propaccesslist[palt_write],def) then
|
||||
begin
|
||||
sym:=p.propaccesslist[palt_write].firstsym^.sym;
|
||||
case sym.typ of
|
||||
procsym :
|
||||
begin
|
||||
{ write is a procedure with an extra value parameter
|
||||
of the of the property }
|
||||
writeprocdef.returndef:=voidtype;
|
||||
inc(paranr);
|
||||
hparavs:=cparavarsym.create('$value',10*paranr,vs_value,p.propdef,[]);
|
||||
writeprocdef.parast.insert(hparavs);
|
||||
{ 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,cpo_ignorehidden])
|
||||
else
|
||||
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)
|
||||
else
|
||||
begin
|
||||
{$ifdef jvm}
|
||||
orgaccesspd:=tprocdef(p.propaccesslist[palt_write].procdef);
|
||||
wrongvisibility:=tprocdef(p.propaccesslist[palt_write].procdef).visibility<p.visibility;
|
||||
if (prop_auto_setter_prefix<>'') and
|
||||
((sym.RealName<>prop_auto_setter_prefix+p.RealName) or
|
||||
wrongvisibility) then
|
||||
jvm_create_setter_for_property(p,orgaccesspd)
|
||||
{ if the visibility of the setter is lower than
|
||||
the visibility of the property, wrap it so that
|
||||
we can call it from all contexts in which the
|
||||
property is visible }
|
||||
else if wrongvisibility then
|
||||
begin
|
||||
p.propaccesslist[palt_write].procdef:=jvm_wrap_method_with_vis(tprocdef(p.propaccesslist[palt_write].procdef),p.visibility);
|
||||
p.propaccesslist[palt_write].firstsym^.sym:=tprocdef(p.propaccesslist[palt_write].procdef).procsym;
|
||||
end;
|
||||
{$endif jvm}
|
||||
end;
|
||||
end;
|
||||
fieldvarsym :
|
||||
begin
|
||||
if not assigned(def) then
|
||||
internalerror(200310072);
|
||||
if compare_defs(def,p.propdef,nothingn)>=te_equal then
|
||||
begin
|
||||
{ property parameters are allowed if this is
|
||||
an indexed property, because the index is then
|
||||
the parameter.
|
||||
Note: In the help of Kylix it is written
|
||||
that it isn't allowed, but the compiler accepts it (PFV) }
|
||||
if (ppo_hasparameters in p.propoptions) or
|
||||
((sp_static in p.symoptions) <> (sp_static in sym.symoptions)) then
|
||||
Message(parser_e_ill_property_access_sym);
|
||||
{$ifdef jvm}
|
||||
{ if the visibility of the field is lower than the
|
||||
visibility of the property, wrap it in a getter
|
||||
so that we can access it from all contexts in
|
||||
which the property is visibile }
|
||||
if (prop_auto_setter_prefix<>'') or
|
||||
(tfieldvarsym(sym).visibility<p.visibility) then
|
||||
jvm_create_setter_for_property(p,nil);
|
||||
{$endif}
|
||||
end
|
||||
else
|
||||
IncompatibleTypes(def,p.propdef);
|
||||
end;
|
||||
else
|
||||
Message(parser_e_ill_property_access_sym);
|
||||
end;
|
||||
if sym.typ=procsym then
|
||||
begin
|
||||
{ settter is a procedure with an extra value parameter
|
||||
of the of the property }
|
||||
writeprocdef.returndef:=voidtype;
|
||||
inc(paranr);
|
||||
hparavs:=cparavarsym.create('$value',10*paranr,vs_value,p.propdef,[]);
|
||||
writeprocdef.parast.insert(hparavs);
|
||||
{ Insert hidden parameters }
|
||||
handle_calling_convention(writeprocdef);
|
||||
end;
|
||||
p.add_getter_or_setter_for_sym(palt_write,sym,def,writeprocdef);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
|
||||
@ -317,6 +317,9 @@ interface
|
||||
tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
|
||||
|
||||
tpropertysym = class(Tstoredsym)
|
||||
protected
|
||||
procedure finalize_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef); virtual;
|
||||
public
|
||||
propoptions : tpropertyoptions;
|
||||
overriddenpropsym : tpropertysym;
|
||||
overriddenpropsymderef : tderef;
|
||||
@ -344,6 +347,8 @@ interface
|
||||
procedure makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
|
||||
procedure add_accessor_parameters(readprocdef, writeprocdef: tprocdef);
|
||||
procedure add_index_parameter(var paranr: word; readprocdef, writeprocdef: tprocdef);
|
||||
{ set up the accessors for this property }
|
||||
procedure add_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef);
|
||||
end;
|
||||
tpropertysymclass = class of tpropertysym;
|
||||
|
||||
@ -1228,6 +1233,12 @@ implementation
|
||||
TPROPERTYSYM
|
||||
****************************************************************************}
|
||||
|
||||
procedure tpropertysym.finalize_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef);
|
||||
begin
|
||||
{ do nothing by default }
|
||||
end;
|
||||
|
||||
|
||||
constructor tpropertysym.create(const n : string);
|
||||
var
|
||||
pap : tpropaccesslisttypes;
|
||||
@ -1376,6 +1387,55 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tpropertysym.add_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef);
|
||||
var
|
||||
cpo: tcompare_paras_options;
|
||||
begin
|
||||
case sym.typ of
|
||||
procsym :
|
||||
begin
|
||||
{ search procdefs matching accessordef }
|
||||
{ we ignore hidden stuff here because the property access symbol might have
|
||||
non default calling conventions which might change the hidden stuff;
|
||||
see tw3216.pp (FK) }
|
||||
cpo:=[cpo_allowdefaults,cpo_ignorehidden];
|
||||
{ allow var-parameters for setters in case of VARPROPSETTER+ }
|
||||
if (getset=palt_write) and
|
||||
(cs_varpropsetter in current_settings.localswitches) then
|
||||
include(cpo,cpo_ignorevarspez);
|
||||
propaccesslist[getset].procdef:=tprocsym(sym).find_procdef_bypara(accessordef.paras,accessordef.returndef,cpo);
|
||||
if not assigned(propaccesslist[getset].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 symoptions)<>tprocdef(propaccesslist[getset].procdef).no_self_node) then
|
||||
Message(parser_e_ill_property_access_sym)
|
||||
else
|
||||
finalize_getter_or_setter_for_sym(getset,sym,fielddef,accessordef);
|
||||
end;
|
||||
fieldvarsym :
|
||||
begin
|
||||
if not assigned(fielddef) then
|
||||
internalerror(200310071);
|
||||
if compare_defs(fielddef,propdef,nothingn)>=te_equal then
|
||||
begin
|
||||
{ property parameters are allowed if this is
|
||||
an indexed property, because the index is then
|
||||
the parameter.
|
||||
Note: In the help of Kylix it is written
|
||||
that it isn't allowed, but the compiler accepts it (PFV) }
|
||||
if (ppo_hasparameters in propoptions) or
|
||||
((sp_static in symoptions) <> (sp_static in sym.symoptions)) then
|
||||
Message(parser_e_ill_property_access_sym)
|
||||
else
|
||||
finalize_getter_or_setter_for_sym(getset,sym,fielddef,accessordef);
|
||||
end
|
||||
else
|
||||
IncompatibleTypes(fielddef,propdef);
|
||||
end;
|
||||
else
|
||||
Message(parser_e_ill_property_access_sym);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tpropertysym.makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user