paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 02:07:53 +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;
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);

198
compiler/pdecvar.pas
View File

@ -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

2
compiler/symdef.pas
View File

@ -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;

4
compiler/tokens.pas
View File

@ -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),