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

git-svn-id: trunk@25108 -

.gitattributes

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

tests/test/cpu16/i8086/tfarptr2.pp

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