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