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,7 +2848,9 @@ const
       end;
 
 
-    procedure handle_calling_convention(pd:tabstractprocdef);
+    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
+      begin
+        if hcc_check in flags then
           begin
             { set the default calling convention if none provided }
             if (pd.typ=procdef) and
@@ -2917,7 +2928,10 @@ const
                     Message(parser_e_varargs_need_cdecl_and_external);
                 end;
              end;
+          end;
 
+        if hcc_insert_hidden_paras in flags then
+          begin
             { insert hidden high parameters }
             pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
 
@@ -2936,6 +2950,7 @@ const
 
             { 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]);
+                            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) then
+                          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.