compiler:

  - postpone insertion of hidden params into record methods after the full record parse to prevent interface and implementation difference because of the possible record size change after the method parse (issue #0021044)
  - skip hidden arguments during methods search for a property setter because of the above change and also for consistency with getter method search
  - test

git-svn-id: trunk@20161 -

.gitattributes

@@ -12168,6 +12168,7 @@ tests/webtbs/tw20995a.pp svneol=native#text/pascal
 tests/webtbs/tw20995b.pp svneol=native#text/pascal
 tests/webtbs/tw20998.pp svneol=native#text/pascal
 tests/webtbs/tw21029.pp svneol=native#text/plain
+tests/webtbs/tw21044.pp svneol=native#text/pascal
 tests/webtbs/tw21073.pp svneol=native#text/plain
 tests/webtbs/tw2109.pp svneol=native#text/plain
 tests/webtbs/tw2110.pp svneol=native#text/plain

compiler/pdecsub.pas

@@ -48,6 +48,15 @@ interface
       );
       tpdflags=set of tpdflag;
 
+      // flags of handle_calling_convention routine
+      thccflag=(
+        hcc_check,                // perform checks and outup errors if found
+        hcc_insert_hidden_paras   // insert hidden parameters
+      );
+      thccflags=set of thccflag;
+    const
+      hcc_all=[hcc_check,hcc_insert_hidden_paras];
+
     function  check_proc_directive(isprocvar:boolean):boolean;
 
     procedure insert_funcret_local(pd:tprocdef);
@@ -56,7 +65,7 @@ interface
     function  proc_get_importname(pd:tprocdef):string;
     procedure proc_set_mangledname(pd:tprocdef);
 
-    procedure handle_calling_convention(pd:tabstractprocdef);
+    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
 
     procedure parse_parameter_dec(pd:tabstractprocdef);
     procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
@@ -2839,103 +2848,109 @@ const
       end;
 
 
-    procedure handle_calling_convention(pd:tabstractprocdef);
+    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
       begin
-        { set the default calling convention if none provided }
-        if (pd.typ=procdef) and
-           (is_objc_class_or_protocol(tprocdef(pd).struct) or
-            is_cppclass(tprocdef(pd).struct)) then
+        if hcc_check in flags then
           begin
-            { none of the explicit calling conventions should be allowed }
-            if (po_hascallingconvention in pd.procoptions) then
-              internalerror(2009032501);
-            if is_cppclass(tprocdef(pd).struct) then
-              pd.proccalloption:=pocall_cppdecl
+            { set the default calling convention if none provided }
+            if (pd.typ=procdef) and
+               (is_objc_class_or_protocol(tprocdef(pd).struct) or
+                is_cppclass(tprocdef(pd).struct)) then
+              begin
+                { none of the explicit calling conventions should be allowed }
+                if (po_hascallingconvention in pd.procoptions) then
+                  internalerror(2009032501);
+                if is_cppclass(tprocdef(pd).struct) then
+                  pd.proccalloption:=pocall_cppdecl
+                else
+                  pd.proccalloption:=pocall_cdecl;
+              end
+            else if not(po_hascallingconvention in pd.procoptions) then
+              pd.proccalloption:=current_settings.defproccall
             else
-              pd.proccalloption:=pocall_cdecl;
-          end
-        else if not(po_hascallingconvention in pd.procoptions) then
-          pd.proccalloption:=current_settings.defproccall
-        else
-          begin
-            if pd.proccalloption=pocall_none then
-              internalerror(200309081);
-          end;
+              begin
+                if pd.proccalloption=pocall_none then
+                  internalerror(200309081);
+              end;
 
-        { handle proccall specific settings }
-        case pd.proccalloption of
-          pocall_cdecl,
-          pocall_cppdecl :
-            begin
-              { check C cdecl para types }
-              check_c_para(pd);
-            end;
-          pocall_far16 :
-            begin
-              { Temporary stub, must be rewritten to support OS/2 far16 }
-              Message1(parser_w_proc_directive_ignored,'FAR16');
+            { handle proccall specific settings }
+            case pd.proccalloption of
+              pocall_cdecl,
+              pocall_cppdecl :
+                begin
+                  { check C cdecl para types }
+                  check_c_para(pd);
+                end;
+              pocall_far16 :
+                begin
+                  { Temporary stub, must be rewritten to support OS/2 far16 }
+                  Message1(parser_w_proc_directive_ignored,'FAR16');
+                end;
             end;
-        end;
 
-        { Inlining is enabled and supported? }
-        if (po_inline in pd.procoptions) and
-           not(cs_do_inline in current_settings.localswitches) then
-          begin
-            { Give an error if inline is not supported by the compiler mode,
-              otherwise only give a warning that this procedure will not be inlined }
-            if not(m_default_inline in current_settings.modeswitches) then
-              Message(parser_e_proc_inline_not_supported)
-            else
-              Message(parser_w_inlining_disabled);
-            exclude(pd.procoptions,po_inline);
-          end;
+            { Inlining is enabled and supported? }
+            if (po_inline in pd.procoptions) and
+               not(cs_do_inline in current_settings.localswitches) then
+              begin
+                { Give an error if inline is not supported by the compiler mode,
+                  otherwise only give a warning that this procedure will not be inlined }
+                if not(m_default_inline in current_settings.modeswitches) then
+                  Message(parser_e_proc_inline_not_supported)
+                else
+                  Message(parser_w_inlining_disabled);
+                exclude(pd.procoptions,po_inline);
+              end;
 
-        { For varargs directive also cdecl and external must be defined }
-        if (po_varargs in pd.procoptions) then
-         begin
-           { check first for external in the interface, if available there
-             then the cdecl must also be there since there is no implementation
-             available to contain it }
-           if parse_only then
-            begin
-              { if external is available, then cdecl must also be available,
-                procvars don't need external }
-              if not((po_external in pd.procoptions) or
-                     (pd.typ=procvardef) or
-                     { for objcclasses this is checked later, because the entire
-                       class may be external.  }
-                     is_objc_class_or_protocol(tprocdef(pd).struct)) and
-                 not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
-                Message(parser_e_varargs_need_cdecl_and_external);
-            end
-           else
-            begin
-              { both must be defined now }
-              if not((po_external in pd.procoptions) or
-                     (pd.typ=procvardef)) or
-                 not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
-                Message(parser_e_varargs_need_cdecl_and_external);
-            end;
-         end;
+            { For varargs directive also cdecl and external must be defined }
+            if (po_varargs in pd.procoptions) then
+             begin
+               { check first for external in the interface, if available there
+                 then the cdecl must also be there since there is no implementation
+                 available to contain it }
+               if parse_only then
+                begin
+                  { if external is available, then cdecl must also be available,
+                    procvars don't need external }
+                  if not((po_external in pd.procoptions) or
+                         (pd.typ=procvardef) or
+                         { for objcclasses this is checked later, because the entire
+                           class may be external.  }
+                         is_objc_class_or_protocol(tprocdef(pd).struct)) and
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
+                    Message(parser_e_varargs_need_cdecl_and_external);
+                end
+               else
+                begin
+                  { both must be defined now }
+                  if not((po_external in pd.procoptions) or
+                         (pd.typ=procvardef)) or
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
+                    Message(parser_e_varargs_need_cdecl_and_external);
+                end;
+             end;
+          end;
 
-        { insert hidden high parameters }
-        pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
+        if hcc_insert_hidden_paras in flags then
+          begin
+            { insert hidden high parameters }
+            pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
 
-        { insert hidden self parameter }
-        insert_self_and_vmt_para(pd);
+            { insert hidden self parameter }
+            insert_self_and_vmt_para(pd);
 
-        { insert funcret parameter if required }
-        insert_funcret_para(pd);
+            { insert funcret parameter if required }
+            insert_funcret_para(pd);
 
-        { Make var parameters regable, this must be done after the calling
-          convention is set. }
-        { this must be done before parentfp is insert, because getting all cases
-          where parentfp must be in a memory location isn't catched properly so
-          we put parentfp never in a register }
-        pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
+            { Make var parameters regable, this must be done after the calling
+              convention is set. }
+            { this must be done before parentfp is insert, because getting all cases
+              where parentfp must be in a memory location isn't catched properly so
+              we put parentfp never in a register }
+            pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
 
-        { insert parentfp parameter if required }
-        insert_parentfp_para(pd);
+            { insert parentfp parameter if required }
+            insert_parentfp_para(pd);
+          end;
 
         { Calculate parameter tlist }
         pd.calcparas;

compiler/pdecvar.pas

@@ -602,11 +602,17 @@ implementation
                           { Insert hidden parameters }
                           handle_calling_convention(writeprocdef);
                           { search procdefs matching writeprocdef }
+                          { skip hidden part (same as for _READ part ) because of the }
+                          { possible different calling conventions and especialy for  }
+                          { records - their methods hidden parameters are handled     }
+                          { after the full record parse                               }
                           if cs_varpropsetter in current_settings.localswitches then
-                            p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults,cpo_ignorevarspez])
+                            p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults,cpo_ignorevarspez,cpo_ignorehidden])
                           else
-                            p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]);
-                          if not assigned(p.propaccesslist[palt_write].procdef) then
+                            p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
+                          if not assigned(p.propaccesslist[palt_write].procdef) or
+                           { because of cpo_ignorehidden we need to compare if it is a static class method and we have a class property }
+                           ((sp_static in p.symoptions) <> tprocdef(p.propaccesslist[palt_write].procdef).no_self_node) then
                             Message(parser_e_ill_property_access_sym);
                         end;
                       fieldvarsym :

compiler/ptype.pas

@@ -402,7 +402,7 @@ implementation
           end;
       end;
 
-    procedure parse_record_members;
+    procedure parse_record_members(procdeflist:TFPObjectList);
 
         procedure maybe_parse_hint_directives(pd:tprocdef);
         var
@@ -548,7 +548,9 @@ implementation
                           begin
                             parse_record_proc_directives(pd);
 
-                            handle_calling_convention(pd);
+                            // postpone adding hidden params
+                            handle_calling_convention(pd,[hcc_check]);
+                            procdeflist.add(pd);
 
                             { add definition to procsym }
                             proc_add_definition(pd);
@@ -618,7 +620,11 @@ implementation
                     if is_classdef and not (po_staticmethod in pd.procoptions) then
                       MessagePos(pd.fileinfo, parser_e_class_methods_only_static_in_records);
 
-                    handle_calling_convention(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_check]);
+                    procdeflist.add(pd);
 
                     { add definition to procsym }
                     proc_add_definition(pd);
@@ -705,6 +711,11 @@ implementation
          old_current_specializedef: tstoreddef;
          old_parse_generic: boolean;
          recst: trecordsymtable;
+         procdeflist: TFPObjectList;
+         i: integer;
+         pd: tprocdef;
+         oldparse_only: boolean;
+         oldpos : tfileposinfo;
       begin
          old_current_structdef:=current_structdef;
          old_current_genericdef:=current_genericdef;
@@ -739,7 +750,23 @@ implementation
            include(current_structdef.defoptions, df_generic);
          parse_generic:=(df_generic in current_structdef.defoptions);
          if m_advanced_records in current_settings.modeswitches then
-           parse_record_members
+           begin
+             procdeflist:=TFPObjectList.Create(false);
+             parse_record_members(procdeflist);
+             // handle calling conventions of record methods
+             oldpos:=current_filepos;
+             oldparse_only:=parse_only;
+             parse_only:=true;
+             for i := 0 to procdeflist.count - 1 do
+               begin
+                 pd:=tprocdef(procdeflist[i]);
+                 current_filepos:=pd.fileinfo;
+                 handle_calling_convention(pd,[hcc_insert_hidden_paras]);
+               end;
+             parse_only:=oldparse_only;
+             current_filepos:=oldpos;
+             procdeflist.free;
+           end
          else
            begin
              read_record_fields([vd_record]);

tests/webtbs/tw21044.pp

@@ -0,0 +1,37 @@
+{ %norun}
+program tw21044;
+
+{$mode Delphi}
+
+uses
+  SysUtils, Classes;
+
+type
+  { TTestRecord }
+
+  TTestRecord = record
+  public
+    function Test(const Lhs, Rhs: TTestRecord): TTestRecord;
+    // operator overloads
+    class operator Add(const Lhs, Rhs: TTestRecord): TTestRecord;
+    // this part changes the size of record and so the way of parameter handling
+    // on some 64bit systems
+  case Boolean of
+    False: (Value: Single);
+    True: (AsInteger: Integer);
+  end;
+
+{ TTestRecord }
+
+function TTestRecord.Test(const Lhs, Rhs: TTestRecord): TTestRecord;
+begin
+  Result.AsInteger := Lhs.AsInteger + Rhs.AsInteger;
+end;
+
+class operator TTestRecord.Add(const Lhs, Rhs: TTestRecord): TTestRecord;
+begin
+  Result.Value := Lhs.Value + Rhs.Value;
+end;
+
+begin
+end.