mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-18 03:49:21 +02:00
* don't try to bitpack types > 32 bit on 32 bit cpus (mantis #16328)
git-svn-id: trunk@15162 -
This commit is contained in:
parent
3295cd8370
commit
2eddd5e704
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -10352,6 +10352,7 @@ tests/webtbs/tw1622.pp svneol=native#text/plain
|
||||
tests/webtbs/tw16222.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw1623.pp svneol=native#text/plain
|
||||
tests/webtbs/tw16311.pp svneol=native#text/plain
|
||||
tests/webtbs/tw16328.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1634.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1658.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1677.pp svneol=native#text/plain
|
||||
|
@ -584,7 +584,11 @@ implementation
|
||||
{ everything can be handled using the the regular array code. }
|
||||
if ((l mod 8) = 0) and
|
||||
(ispowerof2(l div 8,temp) or
|
||||
not is_ordinal(resultdef)) then
|
||||
not is_ordinal(resultdef)
|
||||
{$ifndef cpu64bitalu}
|
||||
or is_64bitint(resultdef)
|
||||
{$endif not cpu64bitalu}
|
||||
) then
|
||||
begin
|
||||
update_reference_reg_mul(maybe_const_reg,l div 8);
|
||||
exit;
|
||||
@ -818,7 +822,11 @@ implementation
|
||||
((mulsize mod 8 = 0) and
|
||||
ispowerof2(mulsize div 8,temp)) or
|
||||
{ only orddefs are bitpacked }
|
||||
not is_ordinal(resultdef)) then
|
||||
not is_ordinal(resultdef)
|
||||
{$ifndef cpu64bitalu}
|
||||
or is_64bitint(resultdef)
|
||||
{$endif not cpu64bitalu}
|
||||
) then
|
||||
dec(location.reference.offset,bytemulsize*tarraydef(left.resultdef).lowrange);
|
||||
|
||||
if right.nodetype=ordconstn then
|
||||
|
@ -1661,10 +1661,14 @@ implementation
|
||||
if ordtype = uvoid then
|
||||
exit;
|
||||
|
||||
{$ifndef cpu64bitalu}
|
||||
if (ordtype in [s64bit,u64bit]) then
|
||||
{$else not cpu64bitalu}
|
||||
if (ordtype = u64bit) or
|
||||
((ordtype = s64bit) and
|
||||
((low <= (system.low(int64) div 2)) or
|
||||
(high > (system.high(int64) div 2)))) then
|
||||
{$endif cpu64bitalu}
|
||||
result := 64
|
||||
else if (low >= 0) and
|
||||
(high <= 1) then
|
||||
|
59
tests/webtbs/tw16328.pp
Normal file
59
tests/webtbs/tw16328.pp
Normal file
@ -0,0 +1,59 @@
|
||||
program test;
|
||||
|
||||
{$mode objfpc}
|
||||
{$r+,q+}
|
||||
{$inline on}
|
||||
|
||||
const
|
||||
DBIDMASK = $FFFFFFFFFFFF;
|
||||
|
||||
type
|
||||
TmydbID = type Longword;
|
||||
TmydbCLSID = type Word;
|
||||
TmydbDBID = 0..(1 shl 48)-1; // Unique ID of the database
|
||||
TmydbDBTYPE = type Byte;
|
||||
|
||||
tarr = bitpacked array[0..10] of TmydbDBID;
|
||||
|
||||
TmydbUID = bitpacked record
|
||||
DBID : TmydbDBID; // Database Identifier
|
||||
PROID : TmydbID; // Profile Identifier
|
||||
OID : TmydbID; // Object Identifier
|
||||
CLSID : TmydbCLSID; // Object Class
|
||||
end;
|
||||
|
||||
function mydbMakeUID(const DBID: TmydbDBID; const PROID: TmydbID; const CLSID: TmydbCLSID; const OID: TmydbID): TmydbUID; inline;
|
||||
begin
|
||||
Result.CLSID := CLSID;
|
||||
Result.DBID := DBID and DBIDMASK;
|
||||
Result.PROID := PROID;
|
||||
Result.OID := OID;
|
||||
end;
|
||||
|
||||
var
|
||||
uid: TmydbUID;
|
||||
arr: tarr;
|
||||
i: longint;
|
||||
begin
|
||||
uid:=mydbMakeUID($987654321654,$12345678,$5432,$18273645);
|
||||
if (uid.CLSID<>$5432) then
|
||||
halt(1);
|
||||
if (uid.DBID<>($987654321654 and DBIDMASK)) then
|
||||
halt(2);
|
||||
if (uid.PROID<>$12345678) then
|
||||
halt(3);
|
||||
if (uid.OID<>$18273645) then
|
||||
halt(4);
|
||||
i:=2;
|
||||
arr[2]:=$987654321654;
|
||||
if (arr[i]<>$987654321654) or
|
||||
(arr[1]<>0) or
|
||||
(arr[3]<>0) then
|
||||
halt(5);
|
||||
arr[2]:=0;
|
||||
arr[i]:=$987654321654;
|
||||
if (arr[i]<>$987654321654) or
|
||||
(arr[1]<>0) or
|
||||
(arr[3]<>0) then
|
||||
halt(6);
|
||||
end.
|
Loading…
Reference in New Issue
Block a user