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

+ add method register_implemented_interface to tobjectdef which registers an implemented interface and - if desired - also initializes the GUID related fields of the objectdef

Browse Source 
* use that method in all locations outside symdef that add add an implemented interface

Based on work by Blaise.ru
This commit is contained in:
Sven/Sarah Barth 2022-01-17 22:41:06 +01:00
parent 76d3a9c4b5
commit 7de854ef1e
4 changed files with 16 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/jvm/pjvm.pas
View File

@ -170,7 +170,7 @@ implementation
include(enumclass.objectoptions,oo_is_enum_class);
include(enumclass.objectoptions,oo_is_sealed);
{ implement FpcEnumValueObtainable interface }
enumclass.ImplementedInterfaces.add(TImplementedInterface.Create(tobjectdef(search_system_type('FPCENUMVALUEOBTAINABLE').typedef)));
enumclass.register_implemented_interface(tobjectdef(search_system_type('FPCENUMVALUEOBTAINABLE').typedef),false);
{ create an alias for this type inside itself: this way we can choose a
name that can be used in generated Pascal code without risking an
identifier conflict (since it is local to this class; the global name

12
compiler/pdecobj.pas
View File

@ -342,13 +342,7 @@ implementation
if find_implemented_interface(current_objectdef,intfdef)<>nil then
Message1(sym_e_duplicate_id,intfdef.objname^)
else
begin
{ allocate and prepare the GUID only if the class
implements some interfaces. }
if current_objectdef.ImplementedInterfaces.count = 0 then
current_objectdef.prepareguid;
current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
end;
current_objectdef.register_implemented_interface(intfdef,true);
end;
@ -382,9 +376,7 @@ implementation
if find_implemented_interface(current_objectdef,intfdef)<>nil then
Message1(sym_e_duplicate_id,intfdef.objname^)
else
begin
current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
end;
current_objectdef.register_implemented_interface(intfdef,false);
end;

3
compiler/pgenutil.pas
View File

@ -2303,8 +2303,7 @@ uses
internalerror(2012101101);
basedef:=cobjectdef.create(tobjectdef(basedef).objecttype,defname,tobjectdef(basedef),false);
for i:=0 to constraintdata.interfaces.count-1 do
tobjectdef(basedef).implementedinterfaces.add(
timplementedinterface.create(tobjectdef(constraintdata.interfaces[i])));
tobjectdef(basedef).register_implemented_interface(tobjectdef(constraintdata.interfaces[i]),false);
end
else
if constraintdata.interfaces.count=1 then

12
compiler/symdef.pas
View File

@ -535,6 +535,7 @@ interface
procedure set_parent(c : tobjectdef);
function find_destructor: tprocdef;
function implements_any_interfaces: boolean;
function register_implemented_interface(intfdef:tobjectdef;useguid:boolean):timplementedinterface;
{ dispinterface support }
function get_next_dispid: longint;
{ enumerator support }
@ -8115,6 +8116,17 @@ implementation
(assigned(childof) and childof.implements_any_interfaces);
end;
function tobjectdef.register_implemented_interface(intfdef:tobjectdef;useguid:boolean):timplementedinterface;
begin
{ allocate the GUID only if the class implements at least one interface }
if useguid then
prepareguid;
result:=timplementedinterface.create(intfdef);
ImplementedInterfaces.Add(result);
end;
function tobjectdef.size : asizeint;
begin
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper,odt_javaclass,odt_interfacejava] then