From c81f34aeee4ba61b7d166e13688203d2b2ac018c Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 30 Apr 2006 14:29:16 +0000 Subject: [PATCH] + parsing of dispinterface properties git-svn-id: trunk@3383 - --- compiler/pdecobj.pas | 2 +- compiler/pdecvar.pas | 198 ++++++++++++++++++++++++------------------- compiler/symdef.pas | 2 +- compiler/tokens.pas | 4 + 4 files changed, 116 insertions(+), 90 deletions(-) diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index ad6acebc69..eb4d1cb783 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -88,7 +88,7 @@ implementation p : tpropertysym; begin { 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 Message(parser_e_syntax_error); consume(_PROPERTY); diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 3b179169ba..29a70507ef 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -352,7 +352,7 @@ implementation begin { do an property override } 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 p.dooverride(tpropertysym(overriden)); end @@ -362,98 +362,120 @@ implementation message(parser_e_no_property_found_to_override); 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 Message(parser_e_cant_publish_that_property); - if try_to_consume(_READ) then - begin - p.readaccess.clear; - if parse_symlist(p.readaccess,def) then - begin - sym:=p.readaccess.firstsym^.sym; - case sym.typ of - procsym : - begin - { read is function returning the type of the property } - readprocdef.rettype:=p.proptype; - { 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.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.proptype.def,[cpo_allowdefaults,cpo_ignorehidden]); - if not assigned(p.readaccess.procdef) then - Message(parser_e_ill_property_access_sym); - end; - fieldvarsym : - begin - if not assigned(def) then - internalerror(200310071); - if compare_defs(def,p.proptype.def,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) then - Message(parser_e_ill_property_access_sym); - end - else - IncompatibleTypes(def,p.proptype.def); - end; - else - Message(parser_e_ill_property_access_sym); + if not(is_dispinterface(aclass)) then + begin + if try_to_consume(_READ) then + begin + p.readaccess.clear; + if parse_symlist(p.readaccess,def) then + begin + sym:=p.readaccess.firstsym^.sym; + case sym.typ of + procsym : + begin + { read is function returning the type of the property } + readprocdef.rettype:=p.proptype; + { 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.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.proptype.def,[cpo_allowdefaults,cpo_ignorehidden]); + if not assigned(p.readaccess.procdef) then + Message(parser_e_ill_property_access_sym); + end; + fieldvarsym : + begin + if not assigned(def) then + internalerror(200310071); + if compare_defs(def,p.proptype.def,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) then + Message(parser_e_ill_property_access_sym); + end + else + IncompatibleTypes(def,p.proptype.def); + end; + else + Message(parser_e_ill_property_access_sym); + end; + end; end; - end; - end; - if try_to_consume(_WRITE) then - begin - p.writeaccess.clear; - if parse_symlist(p.writeaccess,def) then - begin - sym:=p.writeaccess.firstsym^.sym; - case sym.typ of - procsym : - begin - { write is a procedure with an extra value parameter - of the of the property } - writeprocdef.rettype:=voidtype; - inc(paranr); - hparavs:=tparavarsym.create('$value',10*paranr,vs_value,p.proptype,[]); - writeprocdef.parast.insert(hparavs); - { Insert hidden parameters } - handle_calling_convention(writeprocdef); - { search procdefs matching writeprocdef } - p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.rettype.def,[cpo_allowdefaults]); - if not assigned(p.writeaccess.procdef) then - Message(parser_e_ill_property_access_sym); - end; - fieldvarsym : - begin - if not assigned(def) then - internalerror(200310072); - if compare_defs(def,p.proptype.def,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) then - Message(parser_e_ill_property_access_sym); - end - else - IncompatibleTypes(def,p.proptype.def); - end; - else - Message(parser_e_ill_property_access_sym); + if try_to_consume(_WRITE) then + begin + p.writeaccess.clear; + if parse_symlist(p.writeaccess,def) then + begin + sym:=p.writeaccess.firstsym^.sym; + case sym.typ of + procsym : + begin + { write is a procedure with an extra value parameter + of the of the property } + writeprocdef.rettype:=voidtype; + inc(paranr); + hparavs:=tparavarsym.create('$value',10*paranr,vs_value,p.proptype,[]); + writeprocdef.parast.insert(hparavs); + { Insert hidden parameters } + handle_calling_convention(writeprocdef); + { search procdefs matching writeprocdef } + p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.rettype.def,[cpo_allowdefaults]); + if not assigned(p.writeaccess.procdef) then + Message(parser_e_ill_property_access_sym); + end; + fieldvarsym : + begin + if not assigned(def) then + internalerror(200310072); + if compare_defs(def,p.proptype.def,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) then + Message(parser_e_ill_property_access_sym); + end + else + IncompatibleTypes(def,p.proptype.def); + end; + else + Message(parser_e_ill_property_access_sym); + end; + end; end; - end; - end; - if assigned(aclass) then + end + else + 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 include(p.propoptions,ppo_stored); if try_to_consume(_STORED) then diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 6e7c0b0bba..0179ab6849 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -5473,7 +5473,7 @@ implementation result:= assigned(def) and (def.deftype=objectdef) and - (tobjectdef(def).objecttype in [odt_dispinterface]); + (tobjectdef(def).objecttype=odt_dispinterface); end; diff --git a/compiler/tokens.pas b/compiler/tokens.pas index 17c7e0616d..fd82c611c8 100644 --- a/compiler/tokens.pas +++ b/compiler/tokens.pas @@ -207,6 +207,7 @@ type _OVERRIDE, _PLATFORM, _PROPERTY, + _READONLY, _REGISTER, _REQUIRES, _RESIDENT, @@ -223,6 +224,7 @@ type _PUBLISHED, _SOFTFLOAT, _THREADVAR, + _WRITEONLY, _DEPRECATED, _DESTRUCTOR, _IMPLEMENTS, @@ -452,6 +454,7 @@ const (str:'OVERRIDE' ;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:'READONLY' ;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:'RESIDENT' ;special:false;keyword:m_none;op:NOTOKEN), @@ -468,6 +471,7 @@ const (str:'PUBLISHED' ;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:'WRITEONLY' ;special:false;keyword:m_none;op:NOTOKEN), (str:'DEPRECATED' ;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),