Przeglądaj źródła

* all accesses that cannot be handled natively by the code generator have
to be handled as a bitpacked access, not just those whose size mod 8 <> 0
(bug reported by Willibald Krenn on fpc-devel, and mantis #17715)

git-svn-id: trunk@16227 -

Jonas Maebe 14 lat temu
rodzic
commit
9ab050316e
3 zmienionych plików z 67 dodań i 2 usunięć
  1. 1 0
      .gitattributes
  2. 2 2
      compiler/nutils.pas
  3. 64 0
      tests/webtbs/tw17715.pp

+ 1 - 0
.gitattributes

@@ -10720,6 +10720,7 @@ tests/webtbs/tw17646.pp svneol=native#text/plain
 tests/webtbs/tw1765.pp svneol=native#text/plain
 tests/webtbs/tw17675.pp svneol=native#text/plain
 tests/webtbs/tw17675a.pp svneol=native#text/plain
+tests/webtbs/tw17715.pp svneol=native#text/plain
 tests/webtbs/tw1779.pp svneol=native#text/plain
 tests/webtbs/tw1780.pp svneol=native#text/plain
 tests/webtbs/tw1792.pp svneol=native#text/plain

+ 2 - 2
compiler/nutils.pas

@@ -1151,11 +1151,11 @@ implementation
           vecn:
             result:=
               is_packed_array(tvecnode(n).left.resultdef) and
-              (tarraydef(tvecnode(n).left.resultdef).elepackedbitsize mod 8 <> 0);
+              not(tarraydef(tvecnode(n).left.resultdef).elepackedbitsize in [8,16,32,64]);
           subscriptn:
             result:=
               is_packed_record_or_object(tsubscriptnode(n).left.resultdef) and
-              ((tsubscriptnode(n).vs.vardef.packedbitsize mod 8 <> 0) or
+              (not(tsubscriptnode(n).vs.vardef.packedbitsize in [8,16,32,64]) or
                (tsubscriptnode(n).vs.fieldoffset mod 8 <> 0));
           else
             result:=false;

+ 64 - 0
tests/webtbs/tw17715.pp

@@ -0,0 +1,64 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, strutils;
+
+type
+  TPad1   = 0..65535;    // 16 bits padding
+  TLevel1 = 0..63;       // 6 bits
+  TLevel2 = 0..1023;     // 10 bits
+  TLevel3 = 0..16777215; // 24 bits
+  TLevel4 = 0..255;      // 8 bits
+
+  TLevelsRec = bitpacked record
+    level4  : TLevel4;
+    level3  : TLevel3;
+    level2  : TLevel2;
+    level1  : TLevel1;
+    pad     : TPad1;     // padding to make record size 64 bits
+  end;
+
+var
+  id : TLevelsRec;
+begin
+  writeln('record size: ', sizeof(TLevelsRec));
+
+  writeln(StringOfChar('-', 32));
+  FillChar(id, sizeof(id), 0);
+  TLevelsRec(id).level1 := 1;
+  TLevelsRec(id).level2 := 0;
+  TLevelsRec(id).level3 := 3;
+  TLevelsRec(id).level4 := 4;
+  writeln(TLevelsRec(id).level1, ' (', IntToBin(TLevelsRec(id).level1, 8), ')');
+  writeln(TLevelsRec(id).level2, ' (', IntToBin(TLevelsRec(id).level2, 12), ')');
+  writeln(TLevelsRec(id).level3, ' (', IntToBin(TLevelsRec(id).level3, 26), ')');
+  writeln(TLevelsRec(id).level4, ' (', IntToBin(TLevelsRec(id).level4, 10), ')');
+  writeln(IntToBin(int64(id), 64));
+
+  if (TLevelsRec(id).level1 <> 1) then raise Exception.Create('level1 bad');
+  if (TLevelsRec(id).level2 <> 0) then raise Exception.Create('level2 bad');
+  if (TLevelsRec(id).level3 <> 3) then raise Exception.Create('level3 bad');
+  if (TLevelsRec(id).level4 <> 4) then raise Exception.Create('level4 bad');
+
+  writeln(StringOfChar('-', 32));
+  FillChar(id, sizeof(id), 0);
+  TLevelsRec(id).level1 := 1;
+  TLevelsRec(id).level2 := 2;
+  TLevelsRec(id).level3 := 3;
+  TLevelsRec(id).level4 := 4;
+  writeln(TLevelsRec(id).level1, ' (', IntToBin(TLevelsRec(id).level1, 8), ')');
+  writeln(TLevelsRec(id).level2, ' (', IntToBin(TLevelsRec(id).level2, 12), ')');
+  writeln(TLevelsRec(id).level3, ' (', IntToBin(TLevelsRec(id).level3, 26), ')');
+  writeln(TLevelsRec(id).level4, ' (', IntToBin(TLevelsRec(id).level4, 10), ')');
+  writeln(IntToBin(int64(id), 64));
+
+  if (TLevelsRec(id).level1 <> 1) then raise Exception.Create('level1 bad');
+  if (TLevelsRec(id).level2 <> 2) then raise Exception.Create('level2 bad');
+  if (TLevelsRec(id).level3 <> 3) then raise Exception.Create('level3 bad');
+  if (TLevelsRec(id).level4 <> 4) then raise Exception.Create('level4 bad');
+
+end.
+
+