* Fix creating thunk class when inherited interfaces are used

compiler/pmodules.pas

@@ -1203,6 +1203,11 @@ type
             exit;
           end;
 
+        { we need to be able to reference these in descendants,
+          so they must be generated and included in the interface }
+        if (target_cpu=tsystemcpu.cpu_wasm32) then
+          add_synthetic_interface_classes_for_st(curr.globalsymtable,true,false);
+
         { Our interface is compiled, generate CRC and switch to implementation }
         if not(cs_compilesystem in current_settings.moduleswitches) and
           (Errorcount=0) then
@@ -1476,8 +1481,8 @@ type
          // This needs to be done before we generate the VMTs
          if (target_cpu=tsystemcpu.cpu_wasm32) then
            begin
-           add_synthetic_interface_classes_for_st(module.globalsymtable);
+           add_synthetic_interface_classes_for_st(module.globalsymtable,false,true);
-           add_synthetic_interface_classes_for_st(module.localsymtable);
+           add_synthetic_interface_classes_for_st(module.localsymtable,true,true);
            end;
 
          { generate construction functions for all attributes in the unit:
@@ -2542,7 +2547,7 @@ type
 
         { This needs to be done before we generate the VMTs }
         if (target_cpu=tsystemcpu.cpu_wasm32) then
-          add_synthetic_interface_classes_for_st(curr.localsymtable);
+          add_synthetic_interface_classes_for_st(curr.localsymtable,true,true);
 
         { Generate VMTs }
         if Errorcount=0 then

compiler/symconst.pas

@@ -1004,6 +1004,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
 {$endif not jvm}
 
      objecttypes_with_helpers=[odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface];
+     objecttypes_with_thunk=[odt_interfacecorba,odt_interfacecom];
 
 { !! Be sure to keep these in sync with ones in rtl/inc/varianth.inc }
       varempty = 0;

compiler/symcreat.pas

@@ -130,7 +130,7 @@ interface
   { Generate the hidden thunk class for interfaces,
     so we can use them in TVirtualInterface on platforms that do not allow
     generating executable code in memory at runtime.}
-  procedure add_synthetic_interface_classes_for_st(st : tsymtable);
+  procedure add_synthetic_interface_classes_for_st(st : tsymtable; gen_intf, gen_impl : boolean);
 
 
 implementation
@@ -318,8 +318,10 @@ implementation
     function str_parse_objecttypedef(typename : shortstring;str: ansistring): tobjectdef;
      var
        b,oldparse_only: boolean;
+       i : integer;
        tmpstr: ansistring;
        flags : tread_proc_flags;
+       o : TObject;
 
      begin
       result:=nil;
@@ -333,9 +335,18 @@ implementation
       current_scanner.substitutemacro('hidden_interface_class_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index,true);
       current_scanner.readtoken(false);
       type_dec(b);
-      if (current_module.DefList.Last is tobjectdef) and
+      // In the interface part, the object def is not necessarily the last one, the methods also generate defs.
-         (tobjectdef(current_module.DefList.Last).GetTypeName=typename) then
+      i:=current_module.DefList.count-1;
-           result:=tobjectdef(current_module.DefList.Last);
+      While (result=nil) and (i>=0) do
+        begin
+        O:=current_module.DefList[i];
+        if (o is tobjectdef) then
+           if (tobjectdef(o).GetTypeName=typename) then
+             result:=tobjectdef(o);
+        dec(i);
+        end;
+      if result=nil then
+        internalerror(2024050401);
       parse_only:=oldparse_only;
       { remove the temporary macro input file again }
       current_scanner.closeinputfile;
@@ -1537,19 +1548,40 @@ implementation
       result:=offs;
     end;
 
+
+  // return parent Interface def, but skip iunknown.
+
+  function getparent_interface_def(odef : tobjectdef) : tobjectdef;
+
+  begin
+    if (odef.getparentdef is tobjectdef) then
+      begin
+      result:=odef.getparentdef as tobjectdef;
+      if result=interface_iunknown then
+        result:=Nil;
+      end
+    else
+      result:=nil;
+  end;
+
   procedure implement_interface_thunkclass_decl(cn : shortstring; objdef : tobjectdef);
 
   var
-    str : ansistring;
+    parentname,str : ansistring;
     sym : tsym;
     proc : tprocsym absolute sym;
     pd : tprocdef;
-    def : tobjectdef;
+    odef,def : tobjectdef;
     offs,argcount,i,j : integer;
 
   begin
     str:='type '#10;
-    str:=str+cn+' = class(TInterfaceThunk,'+objdef.GetTypeName+')'#10;
+    odef:=getparent_interface_def(objdef);
+    if (oDef=Nil) or (oDef.hiddenclassdef=Nil) then
+      parentname:='TInterfaceThunk'
+    else
+      parentname:=odef.hiddenclassdef.GetTypeName;
+    str:=str+cn+' = class('+parentname+','+objdef.GetTypeName+')'#10;
     str:=str+' protected '#10;
     for I:=0 to objdef.symtable.symList.Count-1 do
       begin
@@ -1583,6 +1615,9 @@ implementation
     if assigned(def) then
       begin
       def.created_in_current_module:=true;
+      if not def.typesym.is_registered then
+        def.typesym.register_sym;
+      def.buildderef;
       include(def.objectoptions,oo_can_have_published);
       end;
     objdef.hiddenclassdef:=def;
@@ -1738,7 +1773,7 @@ implementation
       end;
   end;
 
-  procedure add_synthetic_interface_classes_for_st(st : tsymtable);
+  procedure add_synthetic_interface_classes_for_st(st : tsymtable; gen_intf, gen_impl : boolean);
 
   var
     i   : longint;
@@ -1759,13 +1794,15 @@ implementation
       def:=tdef(st.deflist[i]);
       if (def.typ<>objectdef) then
         continue;
-      if not (objdef.objecttype in [odt_interfacecorba,odt_interfacecom]) then
+      if not (objdef.objecttype in objecttypes_with_thunk) then
         continue;
       if not (oo_can_have_published in objdef.objectoptions) then
         continue;
       // need to add here extended rtti check when it is available
       cn:=generate_thunkclass_name(i,objdef);
+      if gen_intf then
         implement_interface_thunkclass_decl(cn,objdef);
+      if gen_impl then
         implement_interface_thunkclass_impl(cn,objdef);
       end;
     restore_scanner(sstate);
@@ -1774,9 +1811,9 @@ implementation
       begin
       def:=tdef(st.deflist[i]);
       if (def.typ=objectdef) and (objdef.objecttype=odt_class) then
-        add_synthetic_interface_classes_for_st(objdef.symtable)
+        add_synthetic_interface_classes_for_st(objdef.symtable,gen_intf,gen_impl)
       else if (def.typ=recorddef) and (m_advanced_records in current_settings.modeswitches) then
-        add_synthetic_interface_classes_for_st(recdef.symtable);
+        add_synthetic_interface_classes_for_st(recdef.symtable,gen_intf,gen_impl);
       end;
   end;
 

compiler/symdef.pas

@@ -516,10 +516,12 @@ interface
           objecttype     : tobjecttyp;
           { for interfaces that can be invoked using Invoke(),
             this is the definition of the hidden class that is generated by the compiler.
-            we need this definition to reference it in the RTTI, only during compilation of unit. 
+            we need this definition to reference it in the RTTI.
-            so no need to write it to the .ppu file.
+            Since interfaces can inherit, so can these hidden classes,
+            so we need to write this to the ppu to be able to reference the parents.
           }
           hiddenclassdef : tobjectdef;
+          hiddenclassdefref : tderef;
           constructor create(ot:tobjecttyp;const n:string;c:tobjectdef;doregister:boolean);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -1645,7 +1647,7 @@ implementation
 
     function make_mangledname(const typeprefix:TSymStr;st:TSymtable;const suffix:TSymStr):TSymStr;
       var
-        s,
+        s,t,
         prefix : TSymStr;
         hash : qword;
       begin
@@ -1691,8 +1693,11 @@ implementation
              prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
              st:=st.defowner.owner;
            end;
-          { local classes & interfaces are possible (because of closures) }
+          { local classes & interfaces are possible (because of closures)
-          if st.symtabletype<>localsymtable then
+            or parasymtable for this case:
+             class function Trace<TResult>(const Func: TFunc<TLogToken, TResult>): TResult;
+          }
+          if not (st.symtabletype in [localsymtable,parasymtable]) then
             break;
           prefix:='$'+prefix;
         until false;
@@ -7858,6 +7863,8 @@ implementation
         childof:=nil;
         childofderef.reset;
         vmt_fieldderef.reset;
+        hiddenclassdefref.reset;
+
         extendeddefderef.reset;
         cloneddefderef.reset;
         if objecttype=odt_helper then
@@ -7945,6 +7952,8 @@ implementation
          else
            ImplementedInterfaces:=nil;
 
+         if (target_cpu=tsystemcpu.cpu_wasm32) and (objecttype in objecttypes_with_thunk) then
+           ppufile.getderef(hiddenclassdefref);
          if df_copied_def in defoptions then
            begin
              ppufile.getderef(cloneddefderef);
@@ -8143,6 +8152,9 @@ implementation
                end;
            end;
 
+         if (target_cpu=tsystemcpu.cpu_wasm32) and (objecttype in objecttypes_with_thunk) then
+           ppufile.putderef(hiddenclassdefref);
+
          if df_copied_def in defoptions then
            ppufile.putderef(cloneddefderef);
 
@@ -8176,6 +8188,9 @@ implementation
          inherited buildderef;
          vmt_fieldderef.build(vmt_field);
          childofderef.build(childof);
+
+        if (target_cpu=tsystemcpu.cpu_wasm32) and (objecttype in objecttypes_with_thunk) then
+           hiddenclassdefref.build(hiddenclassdef);
          if df_copied_def in defoptions then
            cloneddefderef.build(symtable.defowner)
          else
@@ -8206,6 +8221,8 @@ implementation
          inherited deref;
          vmt_field:=tsym(vmt_fieldderef.resolve);
          childof:=tobjectdef(childofderef.resolve);
+         if (target_cpu=tsystemcpu.cpu_wasm32) and (objecttype in objecttypes_with_thunk) then
+           hiddenclassdef:=tobjectdef(hiddenclassdefref.resolve);
          if df_copied_def in defoptions then
            begin
              cloneddef:=tobjectdef(cloneddefderef.resolve);