Ver código fonte

+ add method register_implemented_interface to tobjectdef which registers an implemented interface and - if desired - also initializes the GUID related fields of the objectdef
* use that method in all locations outside symdef that add add an implemented interface

Based on work by Blaise.ru

Sven/Sarah Barth 3 anos atrás
pai
commit
7de854ef1e
4 arquivos alterados com 16 adições e 13 exclusões
  1. 1 1
      compiler/jvm/pjvm.pas
  2. 2 10
      compiler/pdecobj.pas
  3. 1 2
      compiler/pgenutil.pas
  4. 12 0
      compiler/symdef.pas

+ 1 - 1
compiler/jvm/pjvm.pas

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

+ 2 - 10
compiler/pdecobj.pas

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

+ 1 - 2
compiler/pgenutil.pas

@@ -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 - 0
compiler/symdef.pas

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