paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-20 04:51:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

* all accesses that cannot be handled natively by the code generator have

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2010-10-26 17:17:28 +00:00
parent 3c2a94fad3
commit 9ab050316e
3 changed files with 67 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

4
compiler/nutils.pas
View File

@ -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
tests/webtbs/tw17715.pp Normal file
View File

@ -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.