mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 02:59:33 +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