paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 08:00:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added test tfarptr2.pp, which tests far pointer equality comparison

Browse Source 
git-svn-id: trunk@25108 -
This commit is contained in:
nickysn 2013-07-15 22:13:17 +00:00
parent 1eaa23b738
commit 56fbf8d4fe
2 changed files with 61 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10592,6 +10592,7 @@ tests/test/cg/variants/tvarol91.pp svneol=native#text/plain
tests/test/cg/variants/tvarol94.pp svneol=native#text/plain
tests/test/cg/variants/tvarol96.pp svneol=native#text/plain
tests/test/cpu16/i8086/tfarptr1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr2.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/dumpclass.pp svneol=native#text/plain

60
tests/test/cpu16/i8086/tfarptr2.pp Normal file
View File

@ -0,0 +1,60 @@
{ %cpu=i8086 }
{ far pointer equality comparison tests }
var
ErrorCode: Integer;
procedure Error(Code: Integer);
begin
Writeln('Error: ', code);
ErrorCode := Code;
end;
type
TFarPtrRec = packed record
offset: Word;
segment: Word;
end;
var
FarPtr: FarPointer;
FarPtr2: FarPointer;
FarPtrRec: TFarPtrRec absolute FarPtr;
eq, neq: Boolean;
begin
ErrorCode := 0;
FarPtr := Ptr($1234, $5678);
FarPtr2 := Ptr($1234, $5678);
eq := FarPtr = FarPtr2;
neq := FarPtr <> FarPtr2;
if not eq or neq then
Error(1);
FarPtr := Ptr($1234, $5678);
FarPtr2 := Ptr($4321, $5678);
eq := FarPtr = FarPtr2;
neq := FarPtr <> FarPtr2;
if eq or not neq then
Error(2);
FarPtr := Ptr($1234, $5678);
FarPtr2 := Ptr($1234, $8765);
eq := FarPtr = FarPtr2;
neq := FarPtr <> FarPtr2;
if eq or not neq then
Error(3);
FarPtr := Ptr($1234, $5678);
FarPtr2 := Ptr($4321, $8765);
eq := FarPtr = FarPtr2;
neq := FarPtr <> FarPtr2;
if eq or not neq then
Error(4);
if ErrorCode = 0 then
Writeln('Success!')
else
Halt(ErrorCode);
end.