|
|
@@ -178,16 +178,6 @@ 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;
|
|
|
- procedure maybe_create_overridden_getter_or_setter(getset: tpropaccesslisttypes);
|
|
|
- public
|
|
|
- procedure inherit_accessor(getset: tpropaccesslisttypes); override;
|
|
|
end;
|
|
|
tcpupropertysymclass = class of tcpupropertysym;
|
|
|
|
|
|
@@ -223,367 +213,6 @@ implementation
|
|
|
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;
|
|
|
- accessortyp: tprocoption;
|
|
|
- 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;
|
|
|
- if getter then
|
|
|
- accessortyp:=po_is_auto_getter
|
|
|
- else
|
|
|
- accessortyp:=po_is_auto_setter;
|
|
|
- procoptions:=[accessortyp];
|
|
|
- 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 assigned(sym) then
|
|
|
- begin
|
|
|
- if ((sym.typ<>procsym) or
|
|
|
- (tprocsym(sym).procdeflist.count<>1) or
|
|
|
- not(accessortyp in tprocdef(tprocsym(sym).procdeflist[0]).procoptions)) 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];
|
|
|
- if not(parentpd.synthetickind in [tsk_field_getter,tsk_field_setter]) then
|
|
|
- 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.getcopyas(procdef,pc_normal_no_hidden,''));
|
|
|
- { 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;
|
|
|
- { set the accessor in the property }
|
|
|
- propaccesslist[accesstyp].clear;
|
|
|
- propaccesslist[accesstyp].addsym(sl_call,pd.procsym);
|
|
|
- propaccesslist[accesstyp].procdef:=pd;
|
|
|
- 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,true);
|
|
|
- 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.unique_id_str }
|
|
|
- if not explicitwrapper then
|
|
|
- accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+pd.unique_id_str;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { getter/setter could have parameters in case of indexed access
|
|
|
- -> copy original procdef }
|
|
|
- pd:=tprocdef(orgaccesspd.getcopyas(procdef,pc_normal_no_hidden,''));
|
|
|
- exclude(pd.procoptions,po_abstractmethod);
|
|
|
- exclude(pd.procoptions,po_overridingmethod);
|
|
|
- { can only construct the artificial accessorname now, because it requires
|
|
|
- pd.unique_id_str }
|
|
|
- if not explicitwrapper then
|
|
|
- accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+pd.unique_id_str;
|
|
|
- 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 }
|
|
|
- handle_calling_convention(pd,hcc_default_actions_intf_struct);
|
|
|
- { 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: pshortstring;
|
|
|
- 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 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 }
|
|
|
- if wrongvisibility or
|
|
|
- ((pprefix^<>'') and
|
|
|
- (sym.RealName<>pprefix^+RealName)) then
|
|
|
- create_getter_or_setter_for_property(orgaccesspd,getset=palt_read)
|
|
|
- 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;
|
|
|
-
|
|
|
-
|
|
|
- procedure tcpupropertysym.maybe_create_overridden_getter_or_setter(getset: tpropaccesslisttypes);
|
|
|
- var
|
|
|
- sym: tsym;
|
|
|
- accessordef: tprocdef;
|
|
|
- psym: tpropertysym;
|
|
|
- begin
|
|
|
- { find the last defined getter/setter/field accessed by an inherited
|
|
|
- property }
|
|
|
- psym:=overriddenpropsym;
|
|
|
- while not assigned(psym.propaccesslist[getset].firstsym) do
|
|
|
- begin
|
|
|
- psym:=psym.overriddenpropsym;
|
|
|
- { if there is simply no getter/setter for this property, we're done }
|
|
|
- if not assigned(psym) then
|
|
|
- exit;
|
|
|
- end;
|
|
|
- sym:=psym.propaccesslist[getset].firstsym^.sym;
|
|
|
- case sym.typ of
|
|
|
- procsym:
|
|
|
- begin
|
|
|
- accessordef:=tprocdef(psym.propaccesslist[getset].procdef);
|
|
|
- if accessordef.visibility>=visibility then
|
|
|
- exit;
|
|
|
- end;
|
|
|
- fieldvarsym:
|
|
|
- begin
|
|
|
- if sym.visibility>=visibility then
|
|
|
- exit;
|
|
|
- accessordef:=nil;
|
|
|
- end;
|
|
|
- else
|
|
|
- internalerror(2014061102);
|
|
|
- end;
|
|
|
- propaccesslist[getset]:=psym.propaccesslist[getset].getcopy;
|
|
|
- finalize_getter_or_setter_for_sym(getset,sym,propdef,accessordef);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure tcpupropertysym.inherit_accessor(getset: tpropaccesslisttypes);
|
|
|
- begin
|
|
|
- inherited;
|
|
|
- { new property has higher visibility than previous one -> maybe override
|
|
|
- the getters/setters }
|
|
|
- if assigned(overriddenpropsym) and
|
|
|
- (overriddenpropsym.visibility<visibility) then
|
|
|
- maybe_create_overridden_getter_or_setter(getset);
|
|
|
- end;
|
|
|
|
|
|
|
|
|
{****************************************************************************
|
nickysn