diff --git a/.gitattributes b/.gitattributes index d2adfdc8db..9a8e358ae9 100644 --- a/.gitattributes +++ b/.gitattributes @@ -10591,6 +10591,7 @@ tests/test/cg/variants/tvarol9.pp svneol=native#text/plain 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/tptrsize.pp svneol=native#text/pascal tests/test/cpu16/taddint1.pp svneol=native#text/pascal tests/test/dumpclass.pp svneol=native#text/plain diff --git a/tests/test/cpu16/i8086/tfarptr1.pp b/tests/test/cpu16/i8086/tfarptr1.pp new file mode 100644 index 0000000000..90ee2bd570 --- /dev/null +++ b/tests/test/cpu16/i8086/tfarptr1.pp @@ -0,0 +1,92 @@ +{ %cpu=i8086 } + +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; + I: Integer; + W1, W2: Word; +begin + ErrorCode := 0; + + Writeln('Ptr(const, const)'); + FarPtr := Ptr($1234, $5678); + if FarPtrRec.offset <> $5678 then + Error(1); + if FarPtrRec.segment <> $1234 then + Error(2); + + Writeln('Ptr(const, var)'); + for I := 1 to 1000 do + begin + FarPtr := Ptr($1234, $5678); + W2 := Random($10000); + FarPtr := Ptr($4321, W2); + if FarPtrRec.offset <> W2 then + Error(3); + if FarPtrRec.segment <> $4321 then + Error(4); + end; + + Writeln('Ptr(var, const)'); + for I := 1 to 1000 do + begin + FarPtr := Ptr($1234, $5678); + W1 := Random($10000); + FarPtr := Ptr(W1, $8765); + if FarPtrRec.segment <> W1 then + Error(5); + if FarPtrRec.offset <> $8765 then + Error(6); + end; + + Writeln('Ptr(var, var)'); + for I := 1 to 1000 do + begin + FarPtr := Ptr($1234, $5678); + W1 := Random($10000); + W2 := Random($10000); + FarPtr := Ptr(W1, W2); + if FarPtrRec.segment <> W1 then + Error(7); + if FarPtrRec.offset <> W2 then + Error(8); + end; + + Writeln('nil'); + FarPtr := Ptr($1234, $5678); + FarPtr := nil; + if FarPtrRec.segment <> 0 then + Error(9); + if FarPtrRec.offset <> 0 then + Error(10); + + Writeln('assignment'); + FarPtr := nil; + FarPtr2 := Ptr($2143, $6587); + FarPtr := FarPtr2; + if FarPtrRec.segment <> $2143 then + Error(11); + if FarPtrRec.offset <> $6587 then + Error(12); + + if ErrorCode = 0 then + Writeln('Success!') + else + Halt(ErrorCode); +end.