* only add hidden parameters for objectdef methods after generating the vmt,

    so that they take into account inherited calling conventions (mantis #35233)
   o don't needlessly calculate the paraloc info when generating a JVM mangled
     name

git-svn-id: trunk@41716 -

.gitattributes

@@ -16566,6 +16566,7 @@ tests/webtbs/tw35139a.pp svneol=native#text/plain
 tests/webtbs/tw35149.pp svneol=native#text/plain
 tests/webtbs/tw35187.pp svneol=native#text/pascal
 tests/webtbs/tw3523.pp svneol=native#text/plain
+tests/webtbs/tw35233.pp svneol=native#text/plain
 tests/webtbs/tw3529.pp svneol=native#text/plain
 tests/webtbs/tw3531.pp svneol=native#text/plain
 tests/webtbs/tw3533.pp svneol=native#text/plain

compiler/jvm/jvmdef.pas

@@ -1121,10 +1121,11 @@ implementation
             pd.visibility:=vis_public;
             { result type }
             pd.returndef:=obj;
-            { calling convention, self, ... (not for advanced records, for those
-              this is handled later) }
-            if obj.typ=recorddef then
-              handle_calling_convention(pd,[hcc_declaration,hcc_check])
+            { calling convention }
+            if assigned(current_structdef) or
+               (assigned(pd.owner.defowner) and
+                (pd.owner.defowner.typ=recorddef)) then
+              handle_calling_convention(pd,hcc_default_actions_intf_struct)
             else
               handle_calling_convention(pd,hcc_default_actions_intf);
             { register forward declaration with procsym }

compiler/jvm/pjvm.pas

@@ -322,6 +322,7 @@ implementation
         vmtbuilder:=TVMTBuilder.Create(enumclass);
         vmtbuilder.generate_vmt;
         vmtbuilder.free;
+        insert_struct_hidden_paras(enumclass);
 
         restore_after_new_class(sstate,islocal,oldsymtablestack);
         current_structdef:=old_current_structdef;
@@ -376,8 +377,6 @@ implementation
           then wraps them and calls through to JLRMethod.invoke }
         methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
         finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass);
-        insert_self_and_vmt_para(methoddef);
-        insert_funcret_para(methoddef);
         methoddef.synthetickind:=tsk_jvm_procvar_invoke;
         methoddef.calcparas;
 
@@ -411,8 +410,6 @@ implementation
             symtablestack.push(pvintf.symtable);
             methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
             finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf);
-            insert_self_and_vmt_para(methoddef);
-            insert_funcret_para(methoddef);
             { can't be final/static/private/protected, and must be virtual
               since it's an interface method }
             methoddef.procoptions:=methoddef.procoptions-[po_staticmethod,po_finalmethod];
@@ -436,6 +433,7 @@ implementation
         vmtbuilder:=TVMTBuilder.Create(pvclass);
         vmtbuilder.generate_vmt;
         vmtbuilder.free;
+        insert_struct_hidden_paras(pvclass);
 
         restore_after_new_class(sstate,islocal,oldsymtablestack);
       end;
@@ -477,7 +475,7 @@ implementation
         { wrapper is part of the same symtable as the original procdef }
         symtablestack.push(pd.owner);
         { get a copy of the virtual class method }
-        wrapperpd:=tprocdef(pd.getcopy);
+        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_normal_no_hidden,''));
         { this one is not virtual nor override }
         exclude(wrapperpd.procoptions,po_virtualmethod);
         exclude(wrapperpd.procoptions,po_overridingmethod);
@@ -508,8 +506,8 @@ implementation
         wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
         wrapperpd.skpara:=pd;
         { also create procvar type that we can use in the implementation }
-        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal,''));
-        wrapperpv.calcparas;
+        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal_no_hidden,''));
+        handle_calling_convention(wrapperpv,hcc_default_actions_intf);
         { no use in creating a callback wrapper here, this procvar type isn't
           for public consumption }
         jvm_create_procvar_class_intern('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv,true);
@@ -551,11 +549,6 @@ implementation
           in callnodes, we will have to replace the calls to virtual
           constructors with calls to the wrappers) }
         finish_copied_procdef(wrapperpd,pd.procsym.realname+'__fpcvirtconstrwrapper__',pd.owner,tabstractrecorddef(pd.owner.defowner));
-        { since it was a bare copy, insert the self parameter (we can't just
-          copy the vmt parameter from the constructor, that's different) }
-        insert_self_and_vmt_para(wrapperpd);
-        insert_funcret_para(wrapperpd);
-        wrapperpd.calcparas;
         { implementation: call through to the constructor
           Exception: if the current class is abstract, do not call the
             constructor, since abstract class cannot be constructed (and the

compiler/jvm/symcpu.pas

@@ -334,7 +334,7 @@ implementation
                           proc_add_definition will give an error }
                       end;
                     { add method with the correct visibility }
-                    pd:=tprocdef(parentpd.getcopy);
+                    pd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,''));
                     { get rid of the import accessorname for inherited virtual class methods,
                       it has to be regenerated rather than amended }
                     if [po_classmethod,po_virtualmethod]<=pd.procoptions then
@@ -394,7 +394,7 @@ implementation
           begin
             { getter/setter could have parameters in case of indexed access
               -> copy original procdef }
-            pd:=tprocdef(orgaccesspd.getcopy);
+            pd:=tprocdef(orgaccesspd.getcopyas(procdef,pc_normal_no_hidden,''));
             exclude(pd.procoptions,po_abstractmethod);
             exclude(pd.procoptions,po_overridingmethod);
             { can only construct the artificial accessorname now, because it requires
@@ -488,11 +488,8 @@ implementation
           done already }
         if not assigned(orgaccesspd) then
           begin
-            { calling convention, self, ... }
-            if obj.typ=recorddef then
-              handle_calling_convention(pd,[hcc_declaration,hcc_check])
-            else
-              handle_calling_convention(pd,hcc_default_actions_intf);
+            { calling convention }
+            handle_calling_convention(pd,hcc_default_actions_intf_struct);
             { register forward declaration with procsym }
             proc_add_definition(pd);
           end;
@@ -692,7 +689,6 @@ implementation
       the JVM, this only sets the importname, however) }
     if assigned(paras) then
       begin
-        init_paraloc_info(callerside);
         for i:=0 to paras.count-1 do
           begin
             vs:=tparavarsym(paras[i]);

compiler/pdecl.pas

@@ -888,6 +888,7 @@ implementation
                         vmtbuilder:=TVMTBuilder.Create(tobjectdef(hdef));
                         vmtbuilder.generate_vmt;
                         vmtbuilder.free;
+                        insert_struct_hidden_paras(tobjectdef(hdef));
                       end;
 
                     { In case of an objcclass, verify that all methods have a message

compiler/pdecobj.pas

@@ -72,19 +72,20 @@ implementation
           recorddef:
             begin
               parse_record_proc_directives(pd);
-              // we can't add hidden params here because record is not yet defined
-              // and therefore record size which has influence on paramter passing rules may change too
-              // look at record_dec to see where calling conventions are applied (issue #0021044)
-              handle_calling_convention(pd,[hcc_declaration,hcc_check]);
             end;
           objectdef:
             begin
               parse_object_proc_directives(pd);
-              handle_calling_convention(pd,hcc_default_actions_intf);
             end
           else
             internalerror(2011040502);
         end;
+        // We can't add hidden params here because record is not yet defined
+        // and therefore record size which has influence on paramter passing rules may change too
+        // look at record_dec to see where calling conventions are applied (issue #0021044).
+        // The same goes for objects/classes due to the calling convention that may only be set
+        // later (mantis #35233).
+        handle_calling_convention(pd,hcc_default_actions_intf_struct);
 
         { add definition to procsym }
         proc_add_definition(pd);
@@ -923,7 +924,7 @@ implementation
                      is_classdef and not (po_staticmethod in result.procoptions) then
                     MessagePos(result.fileinfo,parser_e_class_methods_only_static_in_records);
 
-                  handle_calling_convention(result,hcc_default_actions_intf);
+                  handle_calling_convention(result,hcc_default_actions_intf_struct);
 
                   { add definition to procsym }
                   proc_add_definition(result);

compiler/pdecsub.pas

@@ -1696,7 +1696,7 @@ implementation
             // we can't add hidden params here because record is not yet defined
             // and therefore record size which has influence on paramter passing rules may change too
             // look at record_dec to see where calling conventions are applied (issue #0021044)
-            handle_calling_convention(result,[hcc_declaration,hcc_check]);
+            handle_calling_convention(result,hcc_default_actions_intf_struct);
 
             { add definition to procsym }
             proc_add_definition(result);

compiler/pdecvar.pas

@@ -260,7 +260,10 @@ implementation
             var
               sym: tprocsym;
             begin
-              handle_calling_convention(pd,hcc_default_actions_intf);
+              if not assigned(astruct) then
+                handle_calling_convention(pd,hcc_default_actions_intf)
+              else
+                handle_calling_convention(pd,hcc_default_actions_intf_struct);
               sym:=cprocsym.create(prefix+lower(p.realname));
               symtablestack.top.insert(sym);
               pd.procsym:=sym;
@@ -539,7 +542,10 @@ implementation
                       begin
                         readprocdef.returndef:=p.propdef;
                         { Insert hidden parameters }
-                        handle_calling_convention(readprocdef,hcc_default_actions_intf);
+                        if assigned(astruct) then
+                          handle_calling_convention(readprocdef,hcc_default_actions_intf_struct)
+                        else
+                          handle_calling_convention(readprocdef,hcc_default_actions_intf);
                       end;
                     p.add_getter_or_setter_for_sym(palt_read,sym,def,readprocdef);
                   end;
@@ -562,7 +568,10 @@ implementation
                         hparavs:=cparavarsym.create('$value',10*paranr,vs_value,p.propdef,[]);
                         writeprocdef.parast.insert(hparavs);
                         { Insert hidden parameters }
-                        handle_calling_convention(writeprocdef,hcc_default_actions_intf);
+                        if not assigned(astruct) then
+                          handle_calling_convention(writeprocdef,hcc_default_actions_intf)
+                        else
+                          handle_calling_convention(writeprocdef,hcc_default_actions_intf_struct);
                       end;
                     p.add_getter_or_setter_for_sym(palt_write,sym,def,writeprocdef);
                   end;
@@ -650,7 +659,10 @@ implementation
                                    end;
 
                                  { Insert hidden parameters }
-                                 handle_calling_convention(storedprocdef,hcc_default_actions_intf);
+                                 if not assigned(astruct) then
+                                   handle_calling_convention(storedprocdef,hcc_default_actions_intf)
+                                 else
+                                   handle_calling_convention(storedprocdef,hcc_default_actions_intf_struct);
                                  p.propaccesslist[palt_stored].procdef:=Tprocsym(sym).Find_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
                                  if not assigned(p.propaccesslist[palt_stored].procdef) then
                                    message(parser_e_ill_property_storage_sym);

compiler/pgenutil.pas

@@ -1059,6 +1059,7 @@ uses
                       vmtbuilder:=TVMTBuilder.Create(tobjectdef(result));
                       vmtbuilder.generate_vmt;
                       vmtbuilder.free;
+                      insert_struct_hidden_paras(tobjectdef(result));
                     end;
                   { handle params, calling convention, etc }
                   procvardef:

compiler/pparautl.pas

@@ -34,7 +34,7 @@ interface
     procedure insert_funcret_local(pd:tprocdef);
     procedure insert_hidden_para(p:TObject;arg:pointer);
     procedure check_c_para(pd:Tabstractprocdef);
-    procedure insert_record_hidden_paras(astruct: trecorddef);
+    procedure insert_struct_hidden_paras(astruct: tabstractrecorddef);
 
     type
       // flags of the *handle_calling_convention routines
@@ -47,6 +47,7 @@ interface
 
     const
       hcc_default_actions_intf=[hcc_declaration,hcc_check,hcc_insert_hidden_paras];
+      hcc_default_actions_intf_struct=hcc_default_actions_intf-[hcc_insert_hidden_paras];
       hcc_default_actions_impl=[hcc_check,hcc_insert_hidden_paras];
       hcc_default_actions_parse=[hcc_check,hcc_insert_hidden_paras];
       PD_VIRTUAL_MUTEXCLPO = [po_interrupt,po_exports,po_overridingmethod,po_inline,po_staticmethod];
@@ -448,7 +449,7 @@ implementation
       end;
 
 
-    procedure insert_record_hidden_paras(astruct: trecorddef);
+    procedure insert_struct_hidden_paras(astruct: tabstractrecorddef);
       var
         pd: tdef;
         i: longint;
@@ -570,6 +571,13 @@ implementation
 
         if hcc_insert_hidden_paras in flags then
           begin
+            { If the paraloc info has been calculated already, it will be missing for
+              the new parameters we add below. This should never be necessary before
+              we add them, as users of this information would not process these extra
+              parameters in that case }
+            if pd.has_paraloc_info<>callnoside then
+              internalerror(2019031610);
+
             { insert hidden high parameters }
             pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
 
@@ -1086,7 +1094,7 @@ implementation
           representable in source form and we don't need them anyway }
         symtablestack.push(trecorddef(nestedvarsdef).symtable);
         maybe_add_public_default_java_constructor(trecorddef(nestedvarsdef));
-        insert_record_hidden_paras(trecorddef(nestedvarsdef));
+        insert_struct_hidden_paras(trecorddef(nestedvarsdef));
         symtablestack.pop(trecorddef(nestedvarsdef).symtable);
   {$endif}
         symtablestack.free;

compiler/ptype.pas

@@ -1051,7 +1051,7 @@ implementation
          { don't keep track of procdefs in a separate list, because the
            compiler may add additional procdefs (e.g. property wrappers for
            the jvm backend) }
-         insert_record_hidden_paras(trecorddef(current_structdef));
+         insert_struct_hidden_paras(trecorddef(current_structdef));
          { restore symtable stack }
          symtablestack.pop(recst);
          if trecorddef(current_structdef).is_packed and is_managed_type(current_structdef) then

compiler/symcreat.pas

@@ -352,7 +352,7 @@ implementation
             end;
           { if we get here, we did not find it in the current objectdef ->
             add }
-          childpd:=tprocdef(parentpd.getcopy);
+          childpd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,''));
           { get rid of the import name for inherited virtual class methods,
             it has to be regenerated rather than amended }
           if [po_classmethod,po_virtualmethod]<=childpd.procoptions then

compiler/symdef.pas

@@ -590,6 +590,8 @@ interface
          pno_mangledname, pno_noparams);
        tprocnameoptions = set of tprocnameoption;
        tproccopytyp = (pc_normal,
+                       { everything except for hidden parameters }
+                       pc_normal_no_hidden,
                        { always creates a top-level function, removes all
                          special parameters (self, vmt, parentfp, ...) }
                        pc_bareproc,
@@ -5197,7 +5199,7 @@ implementation
                   pvs:=tparavarsym(parast.symlist[j]);
                   { in case of bare proc, don't copy self, vmt or framepointer
                     parameters }
-                  if (copytyp=pc_bareproc) and
+                  if (copytyp in [pc_bareproc,pc_normal_no_hidden]) and
                      (([vo_is_self,vo_is_vmt,vo_is_parentfp,vo_is_result,vo_is_funcret]*pvs.varoptions)<>[]) then
                     continue;
                   if paraprefix='' then
@@ -6144,7 +6146,7 @@ implementation
         { don't create aliases for bare copies, nor copy the funcretsym as
           the function result parameter will be inserted again if necessary
           (e.g. if the calling convention is changed) }
-        if copytyp<>pc_bareproc then
+        if not(copytyp in [pc_bareproc,pc_normal_no_hidden]) then
           begin
             tprocdef(result).aliasnames.concatListcopy(aliasnames);
             if assigned(funcretsym) then

tests/webtbs/tw35233.pp

@@ -0,0 +1,63 @@
+//
+// Submitted by:
+//
+// Gerrit Moeller
+// [private]@gm-software.de
+// www.gm-software.de
+//
+
+{$MODE DELPHI} // <- Without delphi mode the parser correctly issues an error if stdcall is not repeated
+               // in overriding method (see below).
+
+program FPCIntfStdcallOverrideCrash;
+
+type
+
+  ISomeMethod = interface(IUnknown)
+    ['{DBFB482B-76FB-4DB7-A321-1001755B1F9E}']
+    function SomeMethod(const AIntArg: Integer; const AStrArg: WideString): IUnknown; stdcall;
+  end;
+
+
+  TBaseClassImpl = class(TInterfacedObject, ISomeMethod)
+   public
+    function SomeMethod(const AIntArg: Integer; const AStrArg: WideString): IUnknown; virtual; stdcall;
+  end;
+
+
+  TDerivedClassImpl = class(TBaseClassImpl)
+  public
+   //
+   // In delphi mode it is not neccessary to repeat stdcall calling convention in the overriding method.
+   // But the compiler then generates a call stack with another calling convention for the overriding method!
+   // If you call the overriding method through an interface this crashes (SIGSEV) since it is supposed to be stdcall!
+   // Repeating the calling convention in the overriding method fixes the crash.
+   //
+   function SomeMethod(const AIntArg: Integer; const AStrArg: WideString): IUnknown; override; // stdcall; // <- uncommenting stdcall fixes the crash
+  end;
+
+
+function TBaseClassImpl.SomeMethod(const AIntArg: Integer; const AStrArg: WideString): IUnknown; stdcall;
+begin
+  // Arguments corrupt here due to call stack mismatch!
+  Result := nil; // <- SIGSEV crash here due to call stack mismatch!
+end;
+
+function TDerivedClassImpl.SomeMethod(const AIntArg: Integer; const AStrArg: WideString): IUnknown;
+begin
+  // Arguments corrupt here due to call stack mismatch!
+ Result := inherited SomeMethod(AIntArg, AStrArg);
+end;
+
+
+procedure Main;
+var methodIntf: ISomeMethod; unk: IUnknown;
+begin
+  methodIntf := TDerivedClassImpl.Create;
+  unk := methodIntf.SomeMethod(100, 'Some string contents');
+end;
+
+
+begin
+  Main;
+end.