paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-09 17:39:57 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ added another far pointer arithmetic test

Browse Source 
git-svn-id: trunk@27490 -
This commit is contained in:
nickysn 2014-04-06 15:36:17 +00:00
parent cef4092f3d
commit bf1e15fd39
2 changed files with 184 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10839,6 +10839,7 @@ tests/test/cpu16/i8086/tfarcal1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr1.pp svneol=native#text/pascal tests/test/cpu16/i8086/tfarptr1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr2.pp svneol=native#text/pascal tests/test/cpu16/i8086/tfarptr2.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr3.pp svneol=native#text/pascal tests/test/cpu16/i8086/tfarptr3.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr4.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tptrsize.pp svneol=native#text/pascal tests/test/cpu16/i8086/tptrsize.pp svneol=native#text/pascal
tests/test/cpu16/taddint1.pp svneol=native#text/pascal tests/test/cpu16/taddint1.pp svneol=native#text/pascal
tests/test/dumpclass.pp svneol=native#text/plain tests/test/dumpclass.pp svneol=native#text/plain

183
tests/test/cpu16/i8086/tfarptr4.pp Normal file
View File

@ -0,0 +1,183 @@
{ %cpu=i8086 }
{ far pointer arithmetic tests }
{ far pointer arithmetic should work only on the offset,
without changing the segment }
{ this test is the same as tfarptr3, but with different numbers, designed to
expose buggy far pointer arithmetic, where the int16 int is treated as a
signed int and is sign extended to 32-bit and then added to the far pointer
as a 32-bit int }
{$R-}
var
ErrorCode: Integer;
procedure Error(Code: Integer);
begin
Writeln('Error: ', code);
ErrorCode := Code;
end;
var
FarPtr: FarPointer;
FarPtr2: FarPointer;
int16: Integer;
int32: LongInt;
begin
ErrorCode := 0;
Writeln('farptr + int16_var');
FarPtr := Ptr($1234, $F678);
int16 := $7FFF;
FarPtr2 := nil;
FarPtr2 := FarPtr + int16;
if FarPtr2 <> Ptr($1234, $7677) then
Error(1);
Writeln('int16_var + farptr');
FarPtr := Ptr($1234, $F678);
int16 := $7FFF;
FarPtr2 := nil;
FarPtr2 := int16 + FarPtr;
if FarPtr2 <> Ptr($1234, $7677) then
Error(2);
Writeln('farptr + int32_var');
FarPtr := Ptr($1234, $F678);
int32 := $55AA7FFF;
FarPtr2 := nil;
FarPtr2 := FarPtr + int32;
if FarPtr2 <> Ptr($1234, $7677) then
Error(3);
Writeln('int32_var + farptr');
FarPtr := Ptr($1234, $F678);
int32 := $55AA7FFF;
FarPtr2 := nil;
FarPtr2 := int32 + FarPtr;
if FarPtr2 <> Ptr($1234, $7677) then
Error(4);
Writeln('farptr + int16_const');
FarPtr := Ptr($1234, $F678);
FarPtr2 := nil;
FarPtr2 := FarPtr + $7FFF;
if FarPtr2 <> Ptr($1234, $7677) then
Error(5);
Writeln('int16_const + farptr');
FarPtr := Ptr($1234, $F678);
FarPtr2 := nil;
FarPtr2 := $7FFF + FarPtr;
if FarPtr2 <> Ptr($1234, $7677) then
Error(6);
Writeln('farptr + int32_const');
FarPtr := Ptr($1234, $F678);
FarPtr2 := nil;
FarPtr2 := FarPtr + $55AA7FFF;
if FarPtr2 <> Ptr($1234, $7677) then
Error(7);
Writeln('int32_const + farptr');
FarPtr := Ptr($1234, $F678);
FarPtr2 := nil;
FarPtr2 := $55AA7FFF + FarPtr;
if FarPtr2 <> Ptr($1234, $7677) then
Error(8);
{ const }
Writeln('farptr_const + int16_var');
int16 := $7FFF;
FarPtr2 := nil;
FarPtr2 := FarPointer($1234F678) + int16;
if FarPtr2 <> Ptr($1234, $7677) then
Error(9);
Writeln('int16_var + farptr_const');
int16 := $7FFF;
FarPtr2 := nil;
FarPtr2 := int16 + FarPointer($1234F678);
if FarPtr2 <> Ptr($1234, $7677) then
Error(10);
Writeln('farptr_const + int32_var');
int32 := $55AA7FFF;
FarPtr2 := nil;
FarPtr2 := FarPointer($1234F678) + int32;
if FarPtr2 <> Ptr($1234, $7677) then
Error(11);
Writeln('int32_var + farptr_const');
int32 := $55AA7FFF;
FarPtr2 := nil;
FarPtr2 := int32 + FarPointer($1234F678);
if FarPtr2 <> Ptr($1234, $7677) then
Error(12);
Writeln('farptr_const + int16_const');
FarPtr2 := nil;
FarPtr2 := FarPointer($1234F678) + $7FFF;
if FarPtr2 <> Ptr($1234, $7677) then
Error(13);
Writeln('int16_const + farptr_const');
FarPtr2 := nil;
FarPtr2 := $7FFF + FarPointer($1234F678);
if FarPtr2 <> Ptr($1234, $7677) then
Error(14);
Writeln('farptr_const + int32_const');
FarPtr2 := nil;
FarPtr2 := FarPointer($1234F678) + $55AA7FFF;
if FarPtr2 <> Ptr($1234, $7677) then
Error(15);
Writeln('int32_const + farptr_const');
FarPtr2 := nil;
FarPtr2 := $55AA7FFF + FarPointer($1234F678);
if FarPtr2 <> Ptr($1234, $7677) then
Error(16);
Writeln('farptr - int16_var');
FarPtr := Ptr($1234, $0678);
int16 := $7FFF;
FarPtr2 := nil;
FarPtr2 := FarPtr - int16;
if FarPtr2 <> Ptr($1234, $8679) then
Error(17);
Writeln('farptr - int32_var');
FarPtr := Ptr($1234, $0678);
int32 := $55AA7FFF;
FarPtr2 := nil;
FarPtr2 := FarPtr - int32;
if FarPtr2 <> Ptr($1234, $8679) then
Error(18);
Writeln('farptr - int16_const');
FarPtr := Ptr($1234, $0678);
FarPtr2 := nil;
FarPtr2 := FarPtr - $7FFF;
if FarPtr2 <> Ptr($1234, $8679) then
Error(19);
Writeln('farptr - int32_const');
FarPtr := Ptr($1234, $0678);
FarPtr2 := nil;
FarPtr2 := FarPtr - $55AA7FFF;
if FarPtr2 <> Ptr($1234, $8679) then
Error(20);
Writeln('farptr_const - int16_var');
int16 := $7FFF;
FarPtr2 := nil;
FarPtr2 := FarPointer($12340678) - int16;
if FarPtr2 <> Ptr($1234, $8679) then
Error(21);
Writeln('farptr_const - int32_var');
int32 := $55AA7FFF;
FarPtr2 := nil;
FarPtr2 := FarPointer($12340678) - int32;
if FarPtr2 <> Ptr($1234, $8679) then
Error(22);
Writeln('farptr_const - int16_const');
FarPtr2 := nil;
FarPtr2 := FarPointer($12340678) - $7FFF;
if FarPtr2 <> Ptr($1234, $8679) then
Error(23);
Writeln('farptr_const - int32_const');
FarPtr2 := nil;
FarPtr2 := FarPointer($12340678) - $55AA7FFF;
if FarPtr2 <> Ptr($1234, $8679) then
Error(24);
if ErrorCode = 0 then
Writeln('Success!')
else
Halt(ErrorCode);
end.