paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-29 16:42:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ parsing of dispinterface properties

Browse Source 
git-svn-id: trunk@3383 -
This commit is contained in:
florian 2006-04-30 14:29:16 +00:00
parent 7b0821c08a
commit c81f34aeee
4 changed files with 116 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/pdecobj.pas
View File

@ -88,7 +88,7 @@ implementation
p : tpropertysym; p : tpropertysym;
begin begin
{ check for a class } { check for a class }
if not((is_class_or_interface(aktobjectdef)) or if not((is_class_or_interface_or_dispinterface(aktobjectdef)) or
(not(m_tp7 in aktmodeswitches) and (is_object(aktobjectdef)))) then (not(m_tp7 in aktmodeswitches) and (is_object(aktobjectdef)))) then
Message(parser_e_syntax_error); Message(parser_e_syntax_error);
consume(_PROPERTY); consume(_PROPERTY);

198
compiler/pdecvar.pas
View File

@ -352,7 +352,7 @@ implementation
begin begin
{ do an property override } { do an property override }
overriden:=search_class_member(aclass.childof,p.name); overriden:=search_class_member(aclass.childof,p.name);
if assigned(overriden) and (overriden.typ=propertysym) then if assigned(overriden) and (overriden.typ=propertysym) and not(is_dispinterface(aclass)) then
begin begin
p.dooverride(tpropertysym(overriden)); p.dooverride(tpropertysym(overriden));
end end
@ -362,98 +362,120 @@ implementation
message(parser_e_no_property_found_to_override); message(parser_e_no_property_found_to_override);
end; end;
end; end;
if (sp_published in current_object_option) and if ((sp_published in current_object_option) or is_dispinterface(aclass)) and
not(p.proptype.def.is_publishable) then not(p.proptype.def.is_publishable) then
Message(parser_e_cant_publish_that_property); Message(parser_e_cant_publish_that_property);
if try_to_consume(_READ) then if not(is_dispinterface(aclass)) then
begin begin
p.readaccess.clear; if try_to_consume(_READ) then
if parse_symlist(p.readaccess,def) then begin
begin p.readaccess.clear;
sym:=p.readaccess.firstsym^.sym; if parse_symlist(p.readaccess,def) then
case sym.typ of begin
procsym : sym:=p.readaccess.firstsym^.sym;
begin case sym.typ of
{ read is function returning the type of the property } procsym :
readprocdef.rettype:=p.proptype; begin
{ Insert hidden parameters } { read is function returning the type of the property }
handle_calling_convention(readprocdef); readprocdef.rettype:=p.proptype;
{ search procdefs matching readprocdef } { Insert hidden parameters }
{ we ignore hidden stuff here because the property access symbol might have handle_calling_convention(readprocdef);
non default calling conventions which might change the hidden stuff; { search procdefs matching readprocdef }
see tw3216.pp (FK) } { we ignore hidden stuff here because the property access symbol might have
p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.proptype.def,[cpo_allowdefaults,cpo_ignorehidden]); non default calling conventions which might change the hidden stuff;
if not assigned(p.readaccess.procdef) then see tw3216.pp (FK) }
Message(parser_e_ill_property_access_sym); p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.proptype.def,[cpo_allowdefaults,cpo_ignorehidden]);
end; if not assigned(p.readaccess.procdef) then
fieldvarsym : Message(parser_e_ill_property_access_sym);
begin end;
if not assigned(def) then fieldvarsym :
internalerror(200310071); begin
if compare_defs(def,p.proptype.def,nothingn)>=te_equal then if not assigned(def) then
begin internalerror(200310071);
{ property parameters are allowed if this is if compare_defs(def,p.proptype.def,nothingn)>=te_equal then
an indexed property, because the index is then begin
the parameter. { property parameters are allowed if this is
Note: In the help of Kylix it is written an indexed property, because the index is then
that it isn't allowed, but the compiler accepts it (PFV) } the parameter.
if (ppo_hasparameters in p.propoptions) then Note: In the help of Kylix it is written
Message(parser_e_ill_property_access_sym); that it isn't allowed, but the compiler accepts it (PFV) }
end if (ppo_hasparameters in p.propoptions) then
else Message(parser_e_ill_property_access_sym);
IncompatibleTypes(def,p.proptype.def); end
end; else
else IncompatibleTypes(def,p.proptype.def);
Message(parser_e_ill_property_access_sym); end;
else
Message(parser_e_ill_property_access_sym);
end;
end;
end; end;
end; if try_to_consume(_WRITE) then
end; begin
if try_to_consume(_WRITE) then p.writeaccess.clear;
begin if parse_symlist(p.writeaccess,def) then
p.writeaccess.clear; begin
if parse_symlist(p.writeaccess,def) then sym:=p.writeaccess.firstsym^.sym;
begin case sym.typ of
sym:=p.writeaccess.firstsym^.sym; procsym :
case sym.typ of begin
procsym : { write is a procedure with an extra value parameter
begin of the of the property }
{ write is a procedure with an extra value parameter writeprocdef.rettype:=voidtype;
of the of the property } inc(paranr);
writeprocdef.rettype:=voidtype; hparavs:=tparavarsym.create('$value',10*paranr,vs_value,p.proptype,[]);
inc(paranr); writeprocdef.parast.insert(hparavs);
hparavs:=tparavarsym.create('$value',10*paranr,vs_value,p.proptype,[]); { Insert hidden parameters }
writeprocdef.parast.insert(hparavs); handle_calling_convention(writeprocdef);
{ Insert hidden parameters } { search procdefs matching writeprocdef }
handle_calling_convention(writeprocdef); p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.rettype.def,[cpo_allowdefaults]);
{ search procdefs matching writeprocdef } if not assigned(p.writeaccess.procdef) then
p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.rettype.def,[cpo_allowdefaults]); Message(parser_e_ill_property_access_sym);
if not assigned(p.writeaccess.procdef) then end;
Message(parser_e_ill_property_access_sym); fieldvarsym :
end; begin
fieldvarsym : if not assigned(def) then
begin internalerror(200310072);
if not assigned(def) then if compare_defs(def,p.proptype.def,nothingn)>=te_equal then
internalerror(200310072); begin
if compare_defs(def,p.proptype.def,nothingn)>=te_equal then { property parameters are allowed if this is
begin an indexed property, because the index is then
{ property parameters are allowed if this is the parameter.
an indexed property, because the index is then Note: In the help of Kylix it is written
the parameter. that it isn't allowed, but the compiler accepts it (PFV) }
Note: In the help of Kylix it is written if (ppo_hasparameters in p.propoptions) then
that it isn't allowed, but the compiler accepts it (PFV) } Message(parser_e_ill_property_access_sym);
if (ppo_hasparameters in p.propoptions) then end
Message(parser_e_ill_property_access_sym); else
end IncompatibleTypes(def,p.proptype.def);
else end;
IncompatibleTypes(def,p.proptype.def); else
end; Message(parser_e_ill_property_access_sym);
else end;
Message(parser_e_ill_property_access_sym); end;
end; end;
end; end
end; else
if assigned(aclass) then begin
if try_to_consume(_READONLY) then
begin
end
else if try_to_consume(_WRITEONLY) then
begin
end;
if try_to_consume(_DISPID) then
begin
pt:=comp_expr(true);
if is_constintnode(pt) then
// tprocdef(pd).extnumber:=tordconstnode(pt).value
else
Message(parser_e_dispid_must_be_ord_const);
pt.free;
end;
end;
if assigned(aclass) and not(is_dispinterface(aclass)) then
begin begin
include(p.propoptions,ppo_stored); include(p.propoptions,ppo_stored);
if try_to_consume(_STORED) then if try_to_consume(_STORED) then

2
compiler/symdef.pas
View File

@ -5473,7 +5473,7 @@ implementation
result:= result:=
assigned(def) and assigned(def) and
(def.deftype=objectdef) and (def.deftype=objectdef) and
(tobjectdef(def).objecttype in [odt_dispinterface]); (tobjectdef(def).objecttype=odt_dispinterface);
end; end;

4
compiler/tokens.pas
View File

@ -207,6 +207,7 @@ type
_OVERRIDE, _OVERRIDE,
_PLATFORM, _PLATFORM,
_PROPERTY, _PROPERTY,
_READONLY,
_REGISTER, _REGISTER,
_REQUIRES, _REQUIRES,
_RESIDENT, _RESIDENT,
@ -223,6 +224,7 @@ type
_PUBLISHED, _PUBLISHED,
_SOFTFLOAT, _SOFTFLOAT,
_THREADVAR, _THREADVAR,
_WRITEONLY,
_DEPRECATED, _DEPRECATED,
_DESTRUCTOR, _DESTRUCTOR,
_IMPLEMENTS, _IMPLEMENTS,
@ -452,6 +454,7 @@ const
(str:'OVERRIDE' ;special:false;keyword:m_none;op:NOTOKEN), (str:'OVERRIDE' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'PLATFORM' ;special:false;keyword:m_none;op:NOTOKEN), (str:'PLATFORM' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'PROPERTY' ;special:false;keyword:m_property;op:NOTOKEN), (str:'PROPERTY' ;special:false;keyword:m_property;op:NOTOKEN),
(str:'READONLY' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'REGISTER' ;special:false;keyword:m_none;op:NOTOKEN), (str:'REGISTER' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'REQUIRES' ;special:false;keyword:m_none;op:NOTOKEN), (str:'REQUIRES' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'RESIDENT' ;special:false;keyword:m_none;op:NOTOKEN), (str:'RESIDENT' ;special:false;keyword:m_none;op:NOTOKEN),
@ -468,6 +471,7 @@ const
(str:'PUBLISHED' ;special:false;keyword:m_none;op:NOTOKEN), (str:'PUBLISHED' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'SOFTFLOAT' ;special:false;keyword:m_none;op:NOTOKEN), (str:'SOFTFLOAT' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'THREADVAR' ;special:false;keyword:m_all;op:NOTOKEN), (str:'THREADVAR' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'WRITEONLY' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'DEPRECATED' ;special:false;keyword:m_all;op:NOTOKEN), (str:'DEPRECATED' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'DESTRUCTOR' ;special:false;keyword:m_all;op:NOTOKEN), (str:'DESTRUCTOR' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'IMPLEMENTS' ;special:false;keyword:m_none;op:NOTOKEN), (str:'IMPLEMENTS' ;special:false;keyword:m_none;op:NOTOKEN),