paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-30 04:12:24 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ added test for the memory layout of the i8086 large memory model

Browse Source 
git-svn-id: trunk@28040 -
This commit is contained in:
nickysn 2014-06-23 21:08:51 +00:00
parent 1910177cf0
commit 57b233e724
2 changed files with 60 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10855,6 +10855,7 @@ tests/test/cpu16/i8086/tfarptr3.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr4.pp svneol=native#text/pascal tests/test/cpu16/i8086/tfarptr4.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tintr1.pp svneol=native#text/pascal tests/test/cpu16/i8086/tintr1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tintr2.pp svneol=native#text/pascal tests/test/cpu16/i8086/tintr2.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tmml.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

59
tests/test/cpu16/i8086/tmml.pp Normal file
View File

@ -0,0 +1,59 @@
{ %cpu=i8086 }
{ Memory layout test for the large memory model. This test is compatible with
Turbo Pascal 7, because the large model is TP7's memory model. }
{$IFDEF FPC}
{$IFNDEF FPC_MM_LARGE}
{$DEFINE SKIP_TEST}
{$ENDIF not FPC_MM_LARGE}
{$ENDIF FPC}
{$IFDEF SKIP_TEST}
program tmml;
begin
Writeln('Test compiled for the wrong memory model. Goodbye!');
end
{$ELSE SKIP_TEST}
program tmml;
var
CS, DS, SS, HS: Word;
HeapP: Pointer;
ErrorsFound: Boolean;
procedure Error(const S: string);
begin
Writeln('Error! ', S);
ErrorsFound := True;
end;
begin
ErrorsFound := False;
GetMem(HeapP, 5);
CS := CSeg;
DS := DSeg;
SS := SSeg;
HS := Seg(HeapP^);
Writeln('CS=', CS);
Writeln('DS=', DS);
Writeln('SS=', SS);
Writeln('Heap Seg=', HS);
if not (CS < DS) then
Error('CS >= DS');
if not (DS < SS) then
Error('DS >= SS');
if not (SS < HS) then
Error('SS >= HeapSeg');
FreeMem(HeapP, 5);
if ErrorsFound then
begin
Writeln('Errors found!');
Halt(1);
end
else
Writeln('Ok!');
end
{$ENDIF SKIP_TEST}
.