* correctly calculate the number of words spanned by a packed aggregate

that does not start at a multiple of 8 bytes (mantis #23212)

git-svn-id: trunk@22856 -

.gitattributes

@@ -12937,6 +12937,7 @@ tests/webtbs/tw2317.pp svneol=native#text/plain
 tests/webtbs/tw2318.pp svneol=native#text/plain
 tests/webtbs/tw23185.pp svneol=native#text/pascal
 tests/webtbs/tw2318b.pp svneol=native#text/plain
+tests/webtbs/tw23212.pp svneol=native#text/plain
 tests/webtbs/tw2323.pp svneol=native#text/plain
 tests/webtbs/tw2328.pp svneol=native#text/plain
 tests/webtbs/tw2332.pp svneol=native#text/plain

compiler/x86_64/cpupara.pas

@@ -201,7 +201,7 @@ unit cpupara;
 
     function classify_argument(def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint; forward;
 
-    function init_aggregate_classification(def: tdef; varspez: tvarspez; out words: longint; out classes: tx64paraclasses): longint;
+    function init_aggregate_classification(def: tdef; varspez: tvarspez; byte_offset: aint; out words: longint; out classes: tx64paraclasses): longint;
       var
         i: longint;
       begin
@@ -223,7 +223,9 @@ unit cpupara;
         if def.size > 32 then
           exit(0);
 
-        words:=(def.size+7) div 8;
+        { if a struct starts an offset not divisible by 8, it can span extra
+          words }
+        words:=(def.size+byte_offset mod 8+7) div 8;
 
         (* Zero sized arrays or structures are NO_CLASS.  We return 0 to
            signal memory class, so handle it as special case.  *)
@@ -258,6 +260,7 @@ unit cpupara;
             classes[i+pos] :=
               merge_classes(subclasses[i],classes[i+pos]);
           end;
+        inc(result,pos);
       end;
 
 
@@ -344,7 +347,7 @@ unit cpupara;
         num: longint;
         checkalignment: boolean;
       begin
-        result:=init_aggregate_classification(def,varspez,words,classes);
+        result:=init_aggregate_classification(def,varspez,byte_offset,words,classes);
         if (words=0) then
           exit;
 
@@ -405,7 +408,7 @@ unit cpupara;
         num: longint;
         isbitpacked: boolean;
       begin
-        result:=init_aggregate_classification(def,varspez,words,classes);
+        result:=init_aggregate_classification(def,varspez,byte_offset,words,classes);
         if (words=0) then
           exit;
 

tests/webtbs/tw23212.pp

@@ -0,0 +1,153 @@
+program TestCase;
+
+{$MODE DELPHI}
+
+Type
+
+  TSomeRec1 = Packed Record
+    A : Integer; // Changing this to Byte oddly enough will work, but Integer does not..
+    B : Byte;
+  End; { Record }
+
+  TSomeRecord = Packed Record
+    Case A : Cardinal OF
+      0 : (A : TSomeRec1);
+  End; { Record }
+
+  TBaseList<T> = Class
+
+    Private
+
+      // Fields //
+
+      FItems : Array OF T;
+
+    Protected
+
+      // Methods //
+
+      Function  GetItem(Index : Integer) : T; Virtual;
+      Procedure SetItem(Index : Integer; Const Value : T); Virtual;
+
+    Public
+
+      // Methods //
+
+      Constructor Create;
+      Destructor  Destroy; Override;
+
+      // Properties //
+
+      Property Items[Index : Integer] : T Read GetItem Write SetItem; Default;
+
+  End; { Class }
+
+  TSomeList = TBaseList<TSomeRecord>;
+
+  TSomeClass = Class
+
+    Private
+
+      // Fields //
+
+      FItems : TSomeList;
+
+    Public
+
+      // Methods //
+
+      Constructor Create;
+      Destructor  Destroy; Override;
+
+      Procedure GetRec(Index : Integer; Out Rec : TSomeRecord);
+      Procedure SetRec(Index : Integer; Const Rec : TSomeRecord);
+
+  End; { Class }
+
+//****************************************************************************//
+//****************************************************************************//
+//********** TBaseList Class *************************************************//
+//****************************************************************************//
+//****************************************************************************//
+
+//========== Protected Methods ===============================================//
+
+Function  TBaseList<T>.GetItem(Index : Integer) : T;
+Begin
+  Result := FItems[Index];
+End; { Function }
+
+Procedure TBaseList<T>.SetItem(Index : Integer; Const Value : T);
+Begin
+  IF Index >= High(FItems) Then SetLength(FItems, Index + 1);
+  FItems[Index] := Value;
+End; { Procedure }
+
+//========== Public Methods ==================================================//
+
+Constructor TBaseList<T>.Create;
+Begin
+  Inherited;
+End; { Constructor }
+
+Destructor  TBaseList<T>.Destroy;
+Begin
+  Finalize(FItems);
+  Inherited;
+End; { Destructor }
+
+//****************************************************************************//
+//****************************************************************************//
+//********** TSomeClass Class ************************************************//
+//****************************************************************************//
+//****************************************************************************//
+
+//========== Public Methods ==================================================//
+
+Constructor TSomeClass.Create;
+Begin
+  Inherited;
+  FItems := TSomeList.Create;
+End; { Constructor }
+
+Destructor  TSomeClass.Destroy;
+Begin
+  FItems.Free;
+  Inherited;
+End; { Destructor }
+
+Procedure TSomeClass.GetRec(Index : Integer; Out Rec : TSomeRecord);
+Begin
+  Rec := FItems[Index];
+End; { Procedure }
+
+Procedure TSomeClass.SetRec(Index : Integer; Const Rec : TSomeRecord);
+Begin
+  FItems[Index] := Rec;
+End; { Procedure }
+
+//========== Global Variables ================================================//
+
+Var
+
+  C   : TSomeClass;
+  Rec : TSomeRecord;
+
+Begin
+
+  C := TSomeClass.Create;
+
+  Rec.A.A := 42;
+  Rec.A.B := 5;
+
+  C.SetRec(0, Rec);
+  C.GetRec(0, Rec);
+
+  Writeln(Rec.A.A, ',', Rec.A.B);
+
+  C.Free;
+  if (rec.a.a<>42) or (rec.a.b<>5) then
+    halt(1);
+
+End.
+