mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-15 06:29:38 +02:00
* New tests for aligned records
This commit is contained in:
parent
971b8b9217
commit
3e11b0e870
135
tests/test/talignrec1.pp
Normal file
135
tests/test/talignrec1.pp
Normal file
@ -0,0 +1,135 @@
|
|||||||
|
{ %OPT=-O2 }
|
||||||
|
{ %CPU=i386,x86_64 }
|
||||||
|
program talignrec1;
|
||||||
|
|
||||||
|
{ Tests to see if constants and local variables of an aligned array type are correctly positioned in memory }
|
||||||
|
|
||||||
|
type
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
UIntPtr = NativeUInt;
|
||||||
|
{$ENDIF FPC}
|
||||||
|
|
||||||
|
{ An array of 4 chars aligned to a 32-byte boundary }
|
||||||
|
TAlignedRecord = packed record
|
||||||
|
I: LongInt; { Should start at byte 0 }
|
||||||
|
B: Byte; { Should start at byte 4 }
|
||||||
|
S: Single; { Should start at byte 5 }
|
||||||
|
end align 32;
|
||||||
|
|
||||||
|
const
|
||||||
|
TestConst: TAlignedRecord = (I: $1234; B: $56; S: 7.8);
|
||||||
|
|
||||||
|
var
|
||||||
|
FirstEntry: TAlignedRecord;
|
||||||
|
X: Byte;
|
||||||
|
SecondEntry: TAlignedRecord;
|
||||||
|
ThirdEntry: TAlignedRecord;
|
||||||
|
begin
|
||||||
|
if (UIntPtr(@TestConst) mod $20) <> 0 then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: TestConst is not on a 32-byte boundary (address = $', HexStr(@TestConst), ')');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (UIntPtr(@FirstEntry) mod $20) <> 0 then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: FirstEntry is not on a 32-byte boundary (address = $', HexStr(@FirstEntry), ')');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (UIntPtr(@SecondEntry) mod $20) <> 0 then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: SecondEntry is not on a 32-byte boundary (address = $', HexStr(@SecondEntry), ')');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (UIntPtr(@ThirdEntry) mod $20) <> 0 then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: ThirdEntry is not on a 32-byte boundary (address = $', HexStr(@ThirdEntry), ')');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
X := Byte(UIntPtr(@(TestConst.I)) mod $20);
|
||||||
|
if X <> 0 then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: TAlignedRecord.I starts at byte ', X, ' instead of 0');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
X := Byte(UIntPtr(@(TestConst.B)) mod $20);
|
||||||
|
if X <> 4 then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: TAlignedRecord.B starts at byte ', X, ' instead of 4');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
X := Byte(UIntPtr(@(TestConst.S)) mod $20);
|
||||||
|
if X <> 5 then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: TAlignedRecord.S starts at byte ', X, ' instead of 5');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
FirstEntry := TestConst;
|
||||||
|
SecondEntry := TestConst;
|
||||||
|
ThirdEntry := TestConst;
|
||||||
|
|
||||||
|
{ Check to see if FirstEntry's values are correctly assigned }
|
||||||
|
if FirstEntry.I <> TestConst.I then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: FirstEntry.I contains $', HexStr(FirstEntry.I, 4), ' rather than ', HexStr(TestConst.I, 4));
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FirstEntry.B <> TestConst.B then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: FirstEntry.b contains $', HexStr(FirstEntry.B, 2), ' rather than ', HexStr(TestConst.B, 2));
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FirstEntry.S <> TestConst.S then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: FirstEntry.b contains $', FirstEntry.S, ' rather than ', TestConst.S);
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Check to see if SecondEntry's values are correctly assigned }
|
||||||
|
if SecondEntry.I <> TestConst.I then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: SecondEntry.I contains $', HexStr(SecondEntry.I, 4), ' rather than ', HexStr(TestConst.I, 4));
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if SecondEntry.B <> TestConst.B then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: SecondEntry.b contains $', HexStr(SecondEntry.B, 2), ' rather than ', HexStr(TestConst.B, 2));
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if SecondEntry.S <> TestConst.S then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: SecondEntry.b contains $', SecondEntry.S, ' rather than ', TestConst.S);
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Check to see if ThirdEntry's values are correctly assigned }
|
||||||
|
if ThirdEntry.I <> TestConst.I then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: ThirdEntry.I contains $', HexStr(ThirdEntry.I, 4), ' rather than ', HexStr(TestConst.I, 4));
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if ThirdEntry.B <> TestConst.B then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: ThirdEntry.b contains $', HexStr(ThirdEntry.B, 2), ' rather than ', HexStr(TestConst.B, 2));
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if ThirdEntry.S <> TestConst.S then
|
||||||
|
begin
|
||||||
|
WriteLn('FAIL: ThirdEntry.b contains $', ThirdEntry.S, ' rather than ', TestConst.S);
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
WriteLn('ok');
|
||||||
|
end.
|
12
tests/test/talignrecbad1.pp
Normal file
12
tests/test/talignrecbad1.pp
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
{ %FAIL }
|
||||||
|
|
||||||
|
program talignrecbad1;
|
||||||
|
|
||||||
|
{ Alignment must be a power of 2 between 1 and 64... 3 should return a compiler error }
|
||||||
|
|
||||||
|
type BadAlignment = record
|
||||||
|
Field: Integer;
|
||||||
|
end align 3;
|
||||||
|
|
||||||
|
begin
|
||||||
|
end.
|
12
tests/test/talignrecbad2.pp
Normal file
12
tests/test/talignrecbad2.pp
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
{ %FAIL }
|
||||||
|
|
||||||
|
program talignrecbad2;
|
||||||
|
|
||||||
|
{ Alignment must be a power of 2 between 1 and 64... -128 should return a compiler error }
|
||||||
|
|
||||||
|
type BadAlignment = record
|
||||||
|
Field: Integer;
|
||||||
|
end align -128;
|
||||||
|
|
||||||
|
begin
|
||||||
|
end.
|
12
tests/test/talignrecbad3.pp
Normal file
12
tests/test/talignrecbad3.pp
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
{ %FAIL }
|
||||||
|
|
||||||
|
program talignrecbad3;
|
||||||
|
|
||||||
|
{ Alignment must be a power of 2 between 1 and 64... 128 should return a compiler error }
|
||||||
|
|
||||||
|
type BadAlignment = record
|
||||||
|
Field: Integer;
|
||||||
|
end align 128;
|
||||||
|
|
||||||
|
begin
|
||||||
|
end.
|
12
tests/test/talignrecbad4.pp
Normal file
12
tests/test/talignrecbad4.pp
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
{ %FAIL }
|
||||||
|
|
||||||
|
program talignrecbad4;
|
||||||
|
|
||||||
|
{ Alignment must be a power of 2 between 1 and 64... 0 should return a compiler error }
|
||||||
|
|
||||||
|
type BadAlignment = record
|
||||||
|
Field: Integer;
|
||||||
|
end align 0;
|
||||||
|
|
||||||
|
begin
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user