paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 18:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed several dispinterface parsing related stuff

Browse Source 
git-svn-id: trunk@3373 -
This commit is contained in:
florian 2006-04-29 21:39:21 +00:00
parent aa2e2a2829
commit 91434bd791
4 changed files with 24 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
compiler/pdecl.pas
View File

@ -455,9 +455,10 @@ implementation
if (sym.typ=typesym) then
begin
if ((token=_CLASS) or
(token=_INTERFACE)) and
(token=_INTERFACE) or
(token=_DISPINTERFACE)) and
(assigned(ttypesym(sym).restype.def)) and
is_class_or_interface(ttypesym(sym).restype.def) and
is_class_or_interface_or_dispinterface(ttypesym(sym).restype.def) and
(oo_is_forward in tobjectdef(ttypesym(sym).restype.def).objectoptions) then
begin
{ we can ignore the result }

2
compiler/pdecobj.pas
View File

@ -368,7 +368,7 @@ implementation
aktobjectdef.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
p.free;
valid:=string2guid(aktobjectdef.iidstr^,aktobjectdef.iidguid^);
if (classtype=odt_interfacecom) and not assigned(aktobjectdef.iidguid) and not valid then
if (classtype in [odt_interfacecom,odt_dispinterface]) and not assigned(aktobjectdef.iidguid) and not valid then
Message(parser_e_improper_guid_syntax);
end
else

1
compiler/ptype.pas
View File

@ -685,6 +685,7 @@ implementation
aktpackrecords:=oldaktpackrecords;
end;
end;
_DISPINTERFACE,
_CLASS,
_CPPCLASS,
_INTERFACE,

27
compiler/symdef.pas
View File

@ -735,6 +735,7 @@ interface
function is_class(def: tdef): boolean;
function is_cppclass(def: tdef): boolean;
function is_class_or_interface(def: tdef): boolean;
function is_class_or_interface_or_dispinterface(def: tdef): boolean;
{$ifdef x86}
@ -4240,7 +4241,7 @@ implementation
set_parent(c);
objname:=stringdup(upper(n));
objrealname:=stringdup(n);
if objecttype in [odt_interfacecorba,odt_interfacecom] then
if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
prepareguid;
{ setup implemented interfaces }
if objecttype in [odt_class,odt_interfacecorba] then
@ -4270,7 +4271,7 @@ implementation
{ load guid }
iidstr:=nil;
if objecttype in [odt_interfacecom,odt_interfacecorba] then
if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
begin
new(iidguid);
ppufile.getguid(iidguid^);
@ -4373,7 +4374,7 @@ implementation
ppufile.putlongint(vmt_offset);
ppufile.putderef(childofderef);
ppufile.putsmallset(objectoptions);
if objecttype in [odt_interfacecom,odt_interfacecorba] then
if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
begin
ppufile.putguid(iidguid^);
ppufile.putstring(iidstr^);
@ -4480,7 +4481,7 @@ implementation
lastvtableindex:=c.lastvtableindex;
objectoptions:=objectoptions+(c.objectoptions*
inherited_objectoptions);
if not (objecttype in [odt_interfacecom,odt_interfacecorba]) then
if not (objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) then
begin
{ add the data of the anchestor class }
inc(tobjectsymtable(symtable).datasize,tobjectsymtable(c.symtable).datasize);
@ -4501,7 +4502,7 @@ implementation
procedure tobjectdef.insertvmt;
begin
if objecttype in [odt_interfacecom,odt_interfacecorba] then
if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
exit;
if (oo_has_vmt in objectoptions) then
internalerror(12345)
@ -4524,7 +4525,7 @@ implementation
procedure tobjectdef.check_forwards;
begin
if not(objecttype in [odt_interfacecom,odt_interfacecorba]) then
if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) then
tstoredsymtable(symtable).check_forwards;
if (oo_is_forward in objectoptions) then
begin
@ -4586,7 +4587,7 @@ implementation
function tobjectdef.size : aint;
begin
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba] then
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
result:=sizeof(aint)
else
result:=tobjectsymtable(symtable).datasize;
@ -4595,7 +4596,7 @@ implementation
function tobjectdef.alignment:shortint;
begin
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba] then
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
alignment:=sizeof(aint)
else
alignment:=tobjectsymtable(symtable).recordalignment;
@ -4638,6 +4639,7 @@ implementation
function tobjectdef.needs_inittable : boolean;
begin
case objecttype of
odt_dispinterface,
odt_class :
needs_inittable:=false;
odt_interfacecom:
@ -5498,6 +5500,15 @@ implementation
end;
function is_class_or_interface_or_dispinterface(def: tdef): boolean;
begin
result:=
assigned(def) and
(def.deftype=objectdef) and
(tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface]);
end;
{$ifdef x86}
function use_sse(def : tdef) : boolean;
begin