Merged revisions 6583,6605,6633 via svnmerge from

svn+ssh://jonas@svn.freepascal.org/FPC/svn/fpc/trunk

........
r6583 | jonas | 2007-02-20 22:53:46 +0100 (Tue, 20 Feb 2007) | 2 lines

  + support for packed array constants

........
r6605 | jonas | 2007-02-22 17:56:21 +0100 (Thu, 22 Feb 2007) | 3 lines

  * removed some unused code and associated variable
    from parse_packed_array_def

........
r6633 | jonas | 2007-02-24 18:39:06 +0100 (Sat, 24 Feb 2007) | 3 lines

  + support for bitpacked record constants
  + several array/record bitpacking tests from gpc, most work already

........


git-svn-id: http://svn.freepascal.org/svn/fpc/branches/fpc_2_3@6681 3ad0048d-3df7-0310-abae-a5850022a9f2

10 files changed, 831 insertions, 34 deletions

diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas
index b778a422ce..41d619f791 100644
--- a/compiler/ptconst.pas
+++ b/compiler/ptconst.pas
@@ -49,6 +49,126 @@ implementation
 
 {$maxfpuregisters 0}
 
+{*****************************************************************************
+                          Bitpacked value helpers
+*****************************************************************************}
+
+    type
+      tbitpackedval = record
+        curval, nextval: aword;
+        curbitoffset: smallint;
+        loadbitsize,packedbitsize: byte;
+      end;
+
+
+    procedure initbitpackval(out bp: tbitpackedval; packedbitsize: byte);
+      begin
+        bp.curval:=0;
+        bp.nextval:=0;
+        bp.curbitoffset:=0;
+        bp.packedbitsize:=packedbitsize;
+        bp.loadbitsize:=packedbitsloadsize(bp.packedbitsize)*8;
+      end;
+
+
+{$ifopt r+}
+{$defined rangeon}
+{$r-}
+{$endif}
+
+{$ifopt q+}
+{$define overflowon}
+{$q-}
+{$endif}
+    { (values between quotes below refer to fields of bp; fields not         }
+    {  mentioned are unused by this routine)                                 }
+    { bitpacks "value" as bitpacked value of bitsize "packedbitsize" into    }
+    { "curval", which has already been filled up to "curbitoffset", and      }
+    { stores the spillover if any into "nextval". It also updates            }
+    { curbitoffset to reflect how many bits of currval are now used (can be  }
+    { > AIntBits in case of spillover)                                       }
+    procedure bitpackval(value: aword; var bp: tbitpackedval);
+      var
+        shiftcount: longint;
+      begin
+        if (target_info.endian=endian_big) then
+          begin
+            { bitpacked format: left-aligned (i.e., "big endian bitness") }
+            bp.curval:=bp.curval or ((value shl (AIntBits-bp.packedbitsize)) shr bp.curbitoffset);
+            shiftcount:=((AIntBits-bp.packedbitsize)-bp.curbitoffset);
+            { carry-over to the next element? }
+            if (shiftcount<0) then
+              bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl
+                          (AIntBits+shiftcount)
+          end
+        else
+          begin
+            { bitpacked format: right aligned (i.e., "little endian bitness") }
+            bp.curval:=bp.curval or (value shl bp.curbitoffset);
+            { carry-over to the next element? }
+            if (bp.curbitoffset+bp.packedbitsize>AIntBits) then
+              bp.nextval:=value shr (AIntBits-bp.curbitoffset)
+          end;
+        inc(bp.curbitoffset,bp.packedbitsize);
+      end;
+
+{$ifdef rangeon}
+{$r+}
+{$undef rangeon}
+{$endif}
+
+{$ifdef overflowon}
+{$q+}
+{$undef overflowon}
+{$endif}
+
+
+    procedure flush_packed_value(list: tasmlist; var bp: tbitpackedval);
+      var
+        bitstowrite: longint;
+        writeval : byte;
+      begin
+        { these values have to be byte swapped when cross-compiling }
+        { from one endianess to another, but this will be done      }
+        { automatically by the assembler writer                     }
+        if (bp.curbitoffset < AIntBits) then
+          begin
+            { forced flush -> write multiple of loadsize }
+            bitstowrite:=align(bp.curbitoffset,bp.loadbitsize);
+            bp.curbitoffset:=0;
+          end
+        else
+          begin
+            bitstowrite:=AIntBits;
+            dec(bp.curbitoffset,AIntBits);
+          end;
+        while (bitstowrite>=8) do
+          begin
+            if (target_info.endian=endian_little) then
+              begin
+                { write lowest byte }
+                writeval:=byte(bp.curval);
+                bp.curval:=bp.curval shr 8;
+              end
+            else
+              begin
+                { write highest byte }
+                writeval:=bp.curval shr (AIntBits-8);
+                bp.curval:=(bp.curval and (not($ff shl (AIntBits-8)))) shl 8;
+              end;
+            list.concat(tai_const.create_8bit(writeval));
+            dec(bitstowrite,8);
+          end;
+        bp.curval:=bp.nextval;
+        bp.nextval:=0;
+      end;
+
+
+{*****************************************************************************
+                             read typed const
+*****************************************************************************}
+
+
     { this procedure reads typed constants }
     procedure read_typed_const_data(list:tasmlist;def:tdef);
 
@@ -605,6 +725,65 @@ implementation
           n.free;
         end;
 
+
+        { parse a single constant and add it to the packed const info  }
+        { represented by curval etc (see explanation of bitpackval for }
+        { what the different parameters mean)                          }
+        function parse_single_packed_const(list: tasmlist; def: tdef; var bp: tbitpackedval): boolean;
+          var
+            n : tnode;
+          begin
+            result:=true;
+            n:=comp_expr(true);
+            if (n.nodetype <> ordconstn) or
+               not equal_defs(n.resultdef,def) and
+               not is_subequal(n.resultdef,def) then
+              begin
+                n.free;
+                incompatibletypes(n.resultdef,def);
+                consume_all_until(_SEMICOLON);
+                result:=false;
+                exit;
+              end;
+            bitpackval(tordconstnode(n).value,bp);
+            if (bp.curbitoffset>=AIntBits) then
+              flush_packed_value(list,bp);
+            n.free;
+          end;
+
+
+        { parses a packed array constant }
+        procedure parse_packed_array_def(list: tasmlist; def: tarraydef);
+          var
+            i  : aint;
+            bp : tbitpackedval;
+          begin
+            if not(def.elementdef.typ in [orddef,enumdef]) then
+              internalerror(2007022010);
+            { begin of the array }
+            consume(_LKLAMMER);
+            initbitpackval(bp,def.elepackedbitsize);
+            i:=def.lowrange;
+            { can't use for-loop, fails when cross-compiling from }
+            { 32 to 64 bit because i is then 64 bit               }
+            while (i<def.highrange) do
+              begin
+                { get next item of the packed array }
+                if not parse_single_packed_const(list,def.elementdef,bp) then
+                  exit;
+                consume(_COMMA);
+                inc(i);
+              end;
+            { final item }
+            if not parse_single_packed_const(list,def.elementdef,bp) then
+              exit;
+            { flush final incomplete value if necessary }
+            if (bp.curbitoffset <> 0) then
+              flush_packed_value(list,bp);
+            consume(_RKLAMMER);
+          end;
+
+
         procedure parse_arraydef(list:tasmlist;def:tarraydef);
         var
           n : tnode;
@@ -620,11 +799,11 @@ implementation
               consume(_NIL);
               list.concat(Tai_const.Create_sym(nil));
             end
-          { no packed array constants supported }
-          else if is_packed_array(def) then
+          { packed array constant }
+          else if is_packed_array(def) and
+                  (def.elepackedbitsize mod 8 <> 0)  then
             begin
-              Message(type_e_no_const_packed_array);
-              consume_all_until(_RKLAMMER);
+              parse_packed_array_def(list,def);
             end
           { normal array const between brackets }
           else if try_to_consume(_LKLAMMER) then
@@ -759,15 +938,12 @@ implementation
           hs      : string;
           sorg,s  : TIDString;
           tmpguid : tguid;
-          curroffset  : aint;
-          error   : boolean;
+          curroffset,
+          fillbytes  : aint;
+          bp   : tbitpackedval;
+          error,
+          is_packed: boolean;
         begin
-          { no packed record support }
-          if is_packed_record_or_object(def) then
-            begin
-              Message(type_e_no_const_packed_record);
-              exit;
-            end;
           { GUID }
           if (def=rec_tguid) and
              ((token=_CSTRING) or (token=_CCHAR) or (token=_ID)) then
@@ -793,6 +969,16 @@ implementation
               n.free;
               exit;
             end;
+          { bitpacked record? }
+          is_packed:=is_packed_record_or_object(def);
+          if (is_packed) then
+            begin
+              { loadbitsize = 8, bitpacked records are always padded to    }
+              { a multiple of a byte. packedbitsize will be set separately }
+              { for each field                                             }
+              initbitpackval(bp,0);
+              bp.loadbitsize:=8;
+            end;
           { normal record }
           consume(_LKLAMMER);
           curroffset:=0;
@@ -855,31 +1041,62 @@ implementation
                 consume_all_until(_SEMICOLON)
               else
                 begin
-
                   { if needed fill (alignment) }
                   if tfieldvarsym(srsym).fieldoffset>curroffset then
-                     for i:=1 to tfieldvarsym(srsym).fieldoffset-curroffset do
-                       list.concat(Tai_const.Create_8bit(0));
-
-                   { new position }
-                   curroffset:=tfieldvarsym(srsym).fieldoffset+tfieldvarsym(srsym).vardef.size;
-
-                   { read the data }
-                   read_typed_const_data(list,tfieldvarsym(srsym).vardef);
-
-                   { keep previous field for checking whether whole }
-                   { record was initialized (JM)                    }
-                   recsym := srsym;
-                   { goto next field }
-                   inc(symidx);
-                   if symidx<def.symtable.SymList.Count then
-                     srsym:=tsym(def.symtable.SymList[symidx])
+                    begin
+                      if not(is_packed) then
+                        fillbytes:=tfieldvarsym(srsym).fieldoffset-curroffset
+                      else
+                        begin
+                          flush_packed_value(list,bp);
+                          { curoffset is now aligned to the next byte }
+                          curroffset:=align(curroffset,8);
+                          { offsets are in bits in this case }
+                          fillbytes:=(tfieldvarsym(srsym).fieldoffset-curroffset) div 8;
+                        end;
+                      for i:=1 to fillbytes do
+                        list.concat(Tai_const.Create_8bit(0))
+                    end;
+
+                  { new position }
+                  curroffset:=tfieldvarsym(srsym).fieldoffset;
+                  if not(is_packed) then
+                    inc(curroffset,tfieldvarsym(srsym).vardef.size)
                    else
-                     srsym:=nil;
+                     inc(curroffset,tfieldvarsym(srsym).vardef.packedbitsize);
+
+                  { read the data }
+                  if not(is_packed) or
+                     { only orddefs and enumdefs are bitpacked, as in gcc/gpc }
+                     not(tfieldvarsym(srsym).vardef.typ in [orddef,enumdef]) then
+                    begin
+                      if is_packed then
+                        begin
+                          flush_packed_value(list,bp);
+                          curroffset:=align(curroffset,8);
+                        end;          
+                      read_typed_const_data(list,tfieldvarsym(srsym).vardef);
+                    end
+                  else
+                    begin
+                      bp.packedbitsize:=tfieldvarsym(srsym).vardef.packedbitsize;
+                      parse_single_packed_const(list,tfieldvarsym(srsym).vardef,bp);
+                    end;
+
+                  { keep previous field for checking whether whole }
+                  { record was initialized (JM)                    }
+                  recsym := srsym;
+                  { goto next field }
+                  inc(symidx);
+                  if symidx<def.symtable.SymList.Count then
+                    srsym:=tsym(def.symtable.SymList[symidx])
+                  else
+                    srsym:=nil;
 
-                   if token=_SEMICOLON then
-                     consume(_SEMICOLON)
-                   else break;
+                  if token=_SEMICOLON then
+                    consume(_SEMICOLON)
+                  else
+                    break;
                 end;
             end;
 
@@ -892,7 +1109,15 @@ implementation
              ) then
             Message1(parser_w_skipped_fields_after,sorg);
 
-          for i:=1 to def.size-curroffset do
+          if not(is_packed) then
+            fillbytes:=def.size-curroffset
+          else
+            begin
+              flush_packed_value(list,bp);
+              curroffset:=align(curroffset,8);
+              fillbytes:=def.size-(curroffset div 8);
+            end;
+          for i:=1 to fillbytes do
             list.concat(Tai_const.Create_8bit(0));
 
           consume(_RKLAMMER);
diff --git a/tests/test/tparray13.pp b/tests/test/tparray13.pp
new file mode 100644
index 0000000000..798fd36e40
--- /dev/null
+++ b/tests/test/tparray13.pp
@@ -0,0 +1,120 @@
+{$mode macpas}
+
+{$r-}
+
+procedure error(l: longint);
+begin
+  writeln('error near ',l);
+  halt(1);
+end;
+
+
+procedure test8bit;
+type
+  ta = 0..1;
+const
+  b: packed array[0..9] of ta = (1,0,1,1,1,0,1,1,1,0);
+  results: array[0..9] of ta = (1,0,1,1,1,0,1,1,1,0);
+var
+  i: longint;
+begin
+  if (sizeof(b)<>2) then
+   error(1);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(7);
+end;
+
+
+procedure test8to16bit;
+type
+  ta = 0..7;
+const
+  b: packed array[0..5] of ta = (2,4,1,7,5,1);
+  results: array[0..5] of ta = (2,4,1,7,5,1);
+var
+  i: longint;
+begin
+  if (sizeof(b)<>3) then
+    error(16);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(17);
+end;
+
+
+procedure test16bit;
+type
+  ta = 0..511;
+const
+  b: packed array[0..4] of ta = (356,39,485,100,500);
+  results: array[0..4] of ta = (356,39,485,100,500);
+var
+  i: longint;
+begin
+  if (sizeof(b)<>6) then
+    error(26);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(27);
+end;
+
+
+procedure test16to24bit;
+type
+  ta = 0..2047;
+const
+  b: packed array[0..4] of ta = (1000,67,853,512,759);
+  results: array[0..4] of ta = (1000,67,853,512,759);
+var
+  i: longint;
+begin
+  if (sizeof(b)<>7) then
+    error(36);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(37);
+end;
+
+
+procedure test32bit;
+type
+  ta = 0..(1 shl 19) - 1;
+const
+  b: packed array[0..4] of ta = ($0002F687,$00032222,$000178EE,$000057970,$0007E1D2);
+  results: array[0..4] of ta = ($0002F687,$00032222,$000178EE,$000057970,$0007E1D2);
+var
+  i: longint;
+begin
+  if (sizeof(b)<>12) then
+    error(46);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(47);
+end;
+
+
+procedure test32to40bit;
+type
+  ta = 0..$7fffffff;
+const
+  b: packed array[0..4] of ta = ($71567851,$56789ABD,$50F11178,$39D68DDC,$6C7A5A7);
+  results: array[0..4] of ta = ($71567851,$56789ABD,$50F11178,$39D68DDC,$6C7A5A7);
+var
+  i: longint;
+begin
+  if (sizeof(b)<>20) then
+    error(56);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(57);
+end;
+
+begin
+  test8bit;
+  test8to16bit;
+  test16bit;
+  test16to24bit;
+  test32bit;
+  test32to40bit;
+end.
diff --git a/tests/test/tparray14.pp b/tests/test/tparray14.pp
new file mode 100644
index 0000000000..13571c0ac0
--- /dev/null
+++ b/tests/test/tparray14.pp
@@ -0,0 +1,65 @@
+{ based on gpc test pvs1 }
+{ FLAG --extended-pascal }
+
+{TEST 6.6.5.4-1, CLASS=CONFORMANCE}
+
+{ This program tests that pack and unpack are
+  implemented in this compiler as according to the
+  Standard.
+  The compiler fails if the program does not compile. }
+
+program t6p6p5p4d1(output);
+
+{$mode macpas}
+
+type
+   colourtype = (red,pink,orange,yellow,green,blue);
+
+var
+   unone    : array[3..24] of char;
+   pacy     : array[1..4] of char;
+   pactwo   : packed array[6..7] of colourtype;
+   i        : integer;
+   colour   : colourtype;
+   s: string;
+
+const
+   pacone   : packed array[1..4] of char = 'ABCD';
+   untwo    : array[4..8] of colourtype = (red,pink,orange,yellow,green);
+begin
+   pacy:=pacone;
+   if pacy <> 'ABCD' then
+     halt(1);
+   s := pacone;
+   unpack(pacone,unone,5);
+   if (unone[3] <> #0) or
+      (unone[4] <> #0) or
+      (unone[5] <> 'A') or
+      (unone[6] <> 'B') or
+      (unone[7] <> 'C') or
+      (unone[8] <> 'D') or
+      (unone[9] <> #0) or
+      (unone[10] <> #0) or
+      (unone[11] <> #0) then
+     halt(1);
+   colour:=red;
+   for i:=4 to 8 do
+   begin
+      if (untwo[i]<>colour) then
+        halt(2);
+      colour:=succ(colour)
+   end;
+   pack(untwo,5,pactwo);
+   if (pactwo[6] <> pink) or
+      (pactwo[7] <> orange) then
+     halt(1);
+   writeln('unone[5] = ''', unone[5], ''' = ', ord(unone[5]));
+   if unone[5]='A' then
+      writeln(' PASS...6.6.5.4-1')
+   else
+     begin
+       writeln(' FAIL...6.6.5.4-1');
+       halt(1);
+     end;
+end.
+
diff --git a/tests/test/tparray15.pp b/tests/test/tparray15.pp
new file mode 100644
index 0000000000..05c2a7f69f
--- /dev/null
+++ b/tests/test/tparray15.pp
@@ -0,0 +1,28 @@
+{ from gpc testsuite, original name sam7.pas }
+
+{$ifdef fpc}
+{$mode macpas}
+{$endif}
+
+Program Sam7;
+
+Var
+  foo: array [ 'a'..'f' ] of Boolean = ( false, false, true, false, false, false );
+  bar: packed array [ 42..47 ] of Boolean;
+  baz: array [ '0'..'5' ] of Boolean;
+  i: Integer;
+
+begin
+  pack ( foo, 'a', bar );
+  unpack ( bar, baz, '0' );
+  for i:= 0 to 5 do
+    if bar [ 42 + i ] <> baz [ chr(ord('0')+ i) ] then
+      foo [ 'c' ]:= false;
+  if foo [ 'c' ] and bar [ 44 ] then
+    writeln ( 'OK' )
+  else
+    begin
+      writeln ( 'failed ', foo [ 'c' ], ' ', bar [ 44 ] );
+      halt(1)
+    end
+end.
diff --git a/tests/test/tparray16.pp b/tests/test/tparray16.pp
new file mode 100644
index 0000000000..1c2498f28a
--- /dev/null
+++ b/tests/test/tparray16.pp
@@ -0,0 +1,51 @@
+{ from gpc tests, original name pack4.pas }
+
+{$ifdef fpc}
+{$bitpacking on}
+{$endif fpc}
+
+Program PackUnpack;
+
+Var
+  foo: array [ 1..7 ] of Boolean;
+  bar: packed array [ 1..3 ] of Boolean;
+  i: Integer;
+  temp: Boolean;
+
+begin
+  for i:= 1 to 3 do
+    bar [ i ]:= true;
+  for i:= 1 to 7 do
+    foo [ i ]:= false;
+  foo [ 4 ]:= true;
+  foo [ 5 ]:= true;
+  pack ( foo, 3, bar );
+  if bar [ 3 ] and bar [ 2 ] and not bar [ 1 ] then
+    begin
+      for i:= 1 to 3 do
+        begin
+          temp:= not bar [ i ];
+          bar [ i ]:= temp;
+        end { for };
+      unpack ( bar, foo, 5 );
+      if not foo [ 1 ] and not foo [ 2 ] and not foo [ 3 ] and foo [ 4 ]
+         and foo [ 5 ] and not foo [ 6 ] and not foo [ 7 ] then
+        writeln ( 'OK' )
+      else
+        begin
+          write ( 'failed: foo =' );
+          for i:= 1 to 7 do
+            write ( ' ', foo [ i ] );
+          writeln;
+          halt(1);
+        end { else };
+    end { if }
+  else
+    begin
+      write ( 'failed: bar =' );
+      for i:= 1 to 3 do
+        write ( ' ', bar [ i ] );
+      writeln;
+      halt(1);
+    end { else };
+end.
diff --git a/tests/test/tparray17.pp b/tests/test/tparray17.pp
new file mode 100644
index 0000000000..9434a3dee8
--- /dev/null
+++ b/tests/test/tparray17.pp
@@ -0,0 +1,34 @@
+{ from gpc tests, original name: pack6.pas }
+
+{ Introduced the type declaration. Previously, both arrays were `of 0..3'.
+  But EP 6.7.5.4 demands the component types to be the same, not only
+  compatible. GPC detects this now. Frank, 20030417 }
+
+Program Pack6;
+
+{$ifdef fpc}
+{$bitpacking on}
+type
+  Integer = ptrint;
+{$endif}
+
+Type
+  T03 = 0..3;
+
+Var
+  p: packed array [ 1..4 ] of T03;
+  u: array [ 1..4 ] of T03;
+  i: Integer;
+
+begin
+  for i:= 1 to 4 do
+    u [ i ]:= i - 1;
+  pack ( u, 1, p );
+  for i:= 1 to 4 do
+    if p [ i ] <> i - 1 then
+      begin
+        write ( 'failed: p', i, '=', p [ i ], '; ' );
+        halt(1);
+      end;
+  writeln ( 'OK' );
+end.
diff --git a/tests/test/tparray18.pp b/tests/test/tparray18.pp
new file mode 100644
index 0000000000..e03c09a061
--- /dev/null
+++ b/tests/test/tparray18.pp
@@ -0,0 +1,41 @@
+{ from gpc tests, original name: bitfields.pas }
+
+{$ifdef fpc}
+{$bitpacking on}
+{$endif}
+
+Program BitFields;
+
+Var
+  Foo: packed record
+    b: 0..63;
+    a: 0..1;
+  end { Foo };
+
+  r: packed array [ 40..47 ] of 0..1;
+
+  F: Text;
+
+begin
+  assign(f,'bitfields.txt');
+  rewrite ( F );
+  writeln ( F, '42' );
+  writeln ( F, '0' );
+  writeln ( F, '1' );
+  with Foo do
+    begin
+      reset ( F );
+      readln ( F, b );
+      readln ( F, a );
+      readln ( F, r [ 42 ] );
+      close ( F );
+      erase ( F );
+      if ( b = 42 ) and ( a = 0 ) and ( r [ 42 ] = 1 ) then
+        writeln ( 'OK' )
+      else
+        begin
+          writeln ( 'failed: ', b, ' ', a, ' ', r [ 42 ] );
+          halt(1);
+        end;
+    end { with };
+end.
diff --git a/tests/test/tprec11.pp b/tests/test/tprec11.pp
new file mode 100644
index 0000000000..77501804a2
--- /dev/null
+++ b/tests/test/tprec11.pp
@@ -0,0 +1,26 @@
+{ from gpc testsuite, original name: waldek9b.pas }
+
+{$ifdef fpc}
+{$mode macpas}
+{$endif}
+
+program rrr(Output);
+type tr = record end;
+     tp = packed record
+            i : tr;
+          end;
+var a : array [0..15] of tp;
+    pa : packed array [0..15] of tp;
+begin
+  pack (a, 0, pa);
+  if sizeof(a) <> 0 then
+    halt(1);
+  if (sizeof(pa) <> 0) then
+    halt(2);
+  if (sizeof(tr) <> 0) then
+    halt(3);
+  if (sizeof(tp) <> 0) then
+    halt(4);
+  WriteLn ('OK')
+end.
+
diff --git a/tests/test/tprec12.pp b/tests/test/tprec12.pp
new file mode 100644
index 0000000000..e42f4b0680
--- /dev/null
+++ b/tests/test/tprec12.pp
@@ -0,0 +1,169 @@
+{ from gpc tests, original name sam9.pas }
+
+{$ifdef fpc}
+{$mode macpas}
+{$endif}
+
+program sam9;
+
+type
+  e1 = (
+    enum000,
+    enum001,
+    enum002,
+    enum003,
+    enum004,
+    enum005,
+    enum006,
+    enum007,
+    enum008,
+    enum009,
+    enum010,
+    enum011,
+    enum012,
+    enum013,
+    enum014,
+    enum015,
+    enum016,
+    enum017,
+    enum018,
+    enum019,
+    enum020,
+    enum021,
+    enum022,
+    enum023,
+    enum024,
+    enum025,
+    enum026,
+    enum027,
+    enum028,
+    enum029,
+    enum030,
+    enum031,
+    enum032,
+    enum033,
+    enum034,
+    enum035,
+    enum036,
+    enum037,
+    enum038,
+    enum039,
+    enum040,
+    enum041,
+    enum042,
+    enum043,
+    enum044,
+    enum045,
+    enum046,
+    enum047,
+    enum048,
+    enum049,
+    enum050,
+    enum051,
+    enum052,
+    enum053,
+    enum054,
+    enum055,
+    enum056,
+    enum057,
+    enum058,
+    enum059,
+    enum060,
+    enum061,
+    enum062,
+    enum063,
+    enum064,
+    enum065,
+    enum066,
+    enum067,
+    enum068,
+    enum069,
+    enum070,
+    enum071,
+    enum072,
+    enum073,
+    enum074,
+    enum075,
+    enum076,
+    enum077,
+    enum078,
+    enum079,
+    enum080,
+    enum081,
+    enum082,
+    enum083,
+    enum084,
+    enum085,
+    enum086,
+    enum087,
+    enum088,
+    enum089,
+    enum090,
+    enum091,
+    enum092,
+    enum093,
+    enum094,
+    enum095,
+    enum096,
+    enum097,
+    enum098,
+    enum099,
+    enum100,
+    enum101,
+    enum102,
+    enum103,
+    enum104,
+    enum105,
+    enum106,
+    enum107,
+    enum108,
+    enum109,
+    enum110,
+    enum111,
+    enum112,
+    enum113,
+    enum114,
+    enum115,
+    enum116,
+    enum117,
+    enum118,
+    enum119,
+    enum120,
+    enum121,
+    enum122,
+    enum123,
+    enum124,
+    enum125,
+    enum126,
+    enum127,
+    enum128 { Remove this and it works !}
+  );
+
+  r1 = 0 .. 128;
+
+  t1 = packed record { has to be packed }
+    case integer of
+        1: (f1: e1);
+        2: (f2: r1);
+      end;
+
+var
+  v1: t1;
+
+procedure foo;
+begin
+  v1.f1 := enum000;
+  v1.f2 := 127;
+  v1.f2 := 128;
+end;
+
+begin
+  foo;
+  if v1.f1 = enum128 then
+    writeln ( 'OK' )
+  else
+    begin
+      writeln ( 'failed' );
+      halt(1)
+    end
+end.
diff --git a/tests/test/tprec13.pp b/tests/test/tprec13.pp
new file mode 100644
index 0000000000..e60352b42b
--- /dev/null
+++ b/tests/test/tprec13.pp
@@ -0,0 +1,38 @@
+{ from gpc tests, original name pack1.pas }
+
+{$ifdef fpc}
+{$bitpacking on}
+{$endif}
+
+Program Pack1;
+
+Var
+  r: packed record
+       a, b: Boolean;
+       c: false..true;
+       d: 0..3;
+       e: -3..3;
+       i: Integer;
+     end { r };
+  rb: Byte absolute r;
+
+var
+  i: integer;
+begin
+  rb:= 0;
+  with r do
+    begin
+      a:= false;
+      b:= true;
+      c:= false;
+      d:= 2;
+      e:= -1;
+    end { with };
+  if ( SizeOf ( r ) = 1 + SizeOf (Integer) ) and ( rb = {$ifdef FPC_BIG_ENDIAN} %01010111 {$else} %11110010 {$endif} ) then
+    writeln ( 'OK' )
+  else
+    begin
+      writeln ( 'failed ', SizeOf (r), ' ', SizeOf (Integer), ' ', rb );
+      halt(1);
+    end;
+end.