Browse Source

* fixed some problems of previous commit

florian 25 years ago
parent
commit
1ba347c47d
2 changed files with 58 additions and 37 deletions
  1. 16 3
      compiler/hcgdata.pas
  2. 42 34
      compiler/pdecobj.pas

+ 16 - 3
compiler/hcgdata.pas

@@ -1041,12 +1041,22 @@ implementation
   procedure writeinterfaceids(c : pobjectdef);
   procedure writeinterfaceids(c : pobjectdef);
     var
     var
       i: longint;
       i: longint;
+      s1,s2 : string;
     begin
     begin
+       if c^.owner^.name=nil then
+         s1:=''
+       else
+         s1:=c^.owner^.name^;
+       if c^.objname=nil then
+         s2:=''
+       else
+         s2:=upper(c^.objname^);
+      s1:=s1+'$_'+s2;
       if c^.isiidguidvalid then
       if c^.isiidguidvalid then
         begin
         begin
           if (cs_create_smart in aktmoduleswitches) then
           if (cs_create_smart in aktmoduleswitches) then
             datasegment^.concat(new(pai_cut,init));
             datasegment^.concat(new(pai_cut,init));
-          datasegment^.concat(new(pai_symbol,initname_global(c^.vmt_mangledname+'$_IID',0)));
+          datasegment^.concat(new(pai_symbol,initname_global('IID$_'+s1,0)));
           datasegment^.concat(new(pai_const,init_32bit(c^.iidguid.D1)));
           datasegment^.concat(new(pai_const,init_32bit(c^.iidguid.D1)));
           datasegment^.concat(new(pai_const,init_16bit(c^.iidguid.D2)));
           datasegment^.concat(new(pai_const,init_16bit(c^.iidguid.D2)));
           datasegment^.concat(new(pai_const,init_16bit(c^.iidguid.D3)));
           datasegment^.concat(new(pai_const,init_16bit(c^.iidguid.D3)));
@@ -1055,7 +1065,7 @@ implementation
         end;
         end;
       if (cs_create_smart in aktmoduleswitches) then
       if (cs_create_smart in aktmoduleswitches) then
         datasegment^.concat(new(pai_cut,init));
         datasegment^.concat(new(pai_cut,init));
-      datasegment^.concat(new(pai_symbol,initname_global(c^.vmt_mangledname+'$_IIDSTR',0)));
+      datasegment^.concat(new(pai_symbol,initname_global('IIDSTR$_'+s1,0)));
       datasegment^.concat(new(pai_const,init_8bit(length(c^.iidstr^))));
       datasegment^.concat(new(pai_const,init_8bit(length(c^.iidstr^))));
       datasegment^.concat(new(pai_string,init(c^.iidstr^)));
       datasegment^.concat(new(pai_string,init(c^.iidstr^)));
     end;
     end;
@@ -1063,7 +1073,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.10  2000-11-04 14:25:19  florian
+  Revision 1.11  2000-11-04 17:31:00  florian
+    * fixed some problems of previous commit
+
+  Revision 1.10  2000/11/04 14:25:19  florian
     + merged Attila's changes for interfaces, not tested yet
     + merged Attila's changes for interfaces, not tested yet
 
 
   Revision 1.9  2000/11/01 23:04:37  peter
   Revision 1.9  2000/11/01 23:04:37  peter

+ 42 - 34
compiler/pdecobj.pas

@@ -755,13 +755,12 @@ implementation
                    classtype:=odt_cppclass;
                    classtype:=odt_cppclass;
                    consume(_CPPCLASS);
                    consume(_CPPCLASS);
                 end;
                 end;
-{$ifdef SUPPORT_INTERFACE}
               _INTERFACE:
               _INTERFACE:
                 begin
                 begin
                    if aktinterfacetype=it_interfacecom then
                    if aktinterfacetype=it_interfacecom then
-                     objecttype:=odt_interfacecom
+                     classtype:=odt_interfacecom
                    else {it_interfacecorba}
                    else {it_interfacecorba}
-                     objecttype:=odt_interfacecorba;
+                     classtype:=odt_interfacecorba;
                    consume(_INTERFACE);
                    consume(_INTERFACE);
                    { forward declaration }
                    { forward declaration }
                    if not(assigned(fd)) and (token=_SEMICOLON) then
                    if not(assigned(fd)) and (token=_SEMICOLON) then
@@ -769,14 +768,13 @@ implementation
                        { also anonym objects aren't allow (o : object a : longint; end;) }
                        { also anonym objects aren't allow (o : object a : longint; end;) }
                        if n='' then
                        if n='' then
                          Message(parser_f_no_anonym_objects);
                          Message(parser_f_no_anonym_objects);
-                       aktclass:=new(pobjectdef,init(objecttype,n,nil));
+                       aktclass:=new(pobjectdef,init(classtype,n,nil));
                        if (cs_compilesystem in aktmoduleswitches) and
                        if (cs_compilesystem in aktmoduleswitches) and
-                          (objecttype=odt_interfacecom) and (n='IUNKNOWN') then
+                          (classtype=odt_interfacecom) and (n='IUNKNOWN') then
                          interface_iunknown:=aktclass;
                          interface_iunknown:=aktclass;
                        aktclass^.objectoptions:=aktclass^.objectoptions+[oo_is_forward];
                        aktclass^.objectoptions:=aktclass^.objectoptions+[oo_is_forward];
                      end;
                      end;
                 end;
                 end;
-{$endif SUPPORT_INTERFACE}
               _CLASS:
               _CLASS:
                 begin
                 begin
                    classtype:=odt_class;
                    classtype:=odt_class;
@@ -856,6 +854,30 @@ implementation
           end;
           end;
         end;
         end;
 
 
+      procedure readinterfaceiid;
+        var
+          tt: ttype;
+          p : tnode;
+          isiidguidvalid: boolean;
+
+        begin
+          p:=comp_expr(true);
+          do_firstpass(p);
+          if p.nodetype=stringconstn then
+            begin
+              aktclass^.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
+              p.free;
+              aktclass^.isiidguidvalid:=string2guid(aktclass^.iidstr^,aktclass^.iidguid);
+              if (classtype=odt_interfacecom) and not aktclass^.isiidguidvalid then
+                Message(parser_e_improper_guid_syntax);
+            end
+          else
+            begin
+              p.free;
+              Message(cg_e_illegal_expression);
+            end;
+        end;
+
       procedure readparentclasses;
       procedure readparentclasses;
 
 
         begin
         begin
@@ -915,10 +937,17 @@ implementation
                 consume(_RKLAMMER);
                 consume(_RKLAMMER);
              end
              end
            { if no parent class, then a class get tobject as parent }
            { if no parent class, then a class get tobject as parent }
-           else if classtype=odt_class then
+           else if classtype in [odt_class,odt_interfacecom] then
              setclassparent
              setclassparent
            else
            else
              aktclass:=new(pobjectdef,init(classtype,n,nil));
              aktclass:=new(pobjectdef,init(classtype,n,nil));
+           { read GUID }
+             if (classtype in [odt_interfacecom,odt_interfacecorba]) and
+                try_to_consume(_LECKKLAMMER) then
+               begin
+                 readinterfaceiid;
+                 consume(_RECKKLAMMER);
+               end;
         end;
         end;
 
 
       procedure chkcpp;
       procedure chkcpp;
@@ -932,30 +961,6 @@ implementation
              end;
              end;
         end;
         end;
 
 
-      procedure readinterfaceiid;
-        var
-          tt: ttype;
-          p : tnode;
-          isiidguidvalid: boolean;
-
-        begin
-          p:=comp_expr(true);
-          do_firstpass(p);
-          if p.nodetype=stringconstn then
-            begin
-              aktclass^.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
-              p.free;
-              aktclass^.isiidguidvalid:=string2guid(aktclass^.iidstr^,aktclass^.iidguid);
-              if (classtype=odt_interfacecom) and not aktclass^.isiidguidvalid then
-                Message(parser_e_improper_guid_syntax);
-            end
-          else
-            begin
-              p.free;
-              Message(cg_e_illegal_expression);
-            end;
-        end;
-
       var
       var
         temppd : pprocdef;
         temppd : pprocdef;
       begin
       begin
@@ -1007,7 +1012,7 @@ implementation
          procinfo^._class:=aktclass;
          procinfo^._class:=aktclass;
 
 
 
 
-       { short class declaration ? }
+         { short class declaration ? }
          if (classtype<>odt_class) or (token<>_SEMICOLON) then
          if (classtype<>odt_class) or (token<>_SEMICOLON) then
           begin
           begin
           { Parse componenten }
           { Parse componenten }
@@ -1122,7 +1127,7 @@ implementation
          { generate vmt space if needed }
          { generate vmt space if needed }
          if not(oo_has_vmt in aktclass^.objectoptions) and
          if not(oo_has_vmt in aktclass^.objectoptions) and
             (([oo_has_virtual,oo_has_constructor,oo_has_destructor]*aktclass^.objectoptions<>[]) or
             (([oo_has_virtual,oo_has_constructor,oo_has_destructor]*aktclass^.objectoptions<>[]) or
-             (classtype=odt_class)
+             (classtype in [odt_class])
             ) then
             ) then
            aktclass^.insertvmt;
            aktclass^.insertvmt;
          if (cs_create_smart in aktmoduleswitches) then
          if (cs_create_smart in aktmoduleswitches) then
@@ -1152,7 +1157,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2000-11-04 14:25:20  florian
+  Revision 1.6  2000-11-04 17:31:00  florian
+    * fixed some problems of previous commit
+
+  Revision 1.5  2000/11/04 14:25:20  florian
     + merged Attila's changes for interfaces, not tested yet
     + merged Attila's changes for interfaces, not tested yet
 
 
   Revision 1.4  2000/10/31 22:02:49  peter
   Revision 1.4  2000/10/31 22:02:49  peter