From 57b233e724966a51001faa87de57b24e3faba2ac Mon Sep 17 00:00:00 2001
From: nickysn <nickysn@gmail.com>
Date: Mon, 23 Jun 2014 21:08:51 +0000
Subject: [PATCH] + added test for the memory layout of the i8086 large memory
 model

git-svn-id: trunk@28040 -
---
 .gitattributes                 |  1 +
 tests/test/cpu16/i8086/tmml.pp | 59 ++++++++++++++++++++++++++++++++++
 2 files changed, 60 insertions(+)
 create mode 100644 tests/test/cpu16/i8086/tmml.pp

diff --git a/.gitattributes b/.gitattributes
index 2790c74451..38146c44f6 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -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/tintr1.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/taddint1.pp svneol=native#text/pascal
 tests/test/dumpclass.pp svneol=native#text/plain
diff --git a/tests/test/cpu16/i8086/tmml.pp b/tests/test/cpu16/i8086/tmml.pp
new file mode 100644
index 0000000000..4f780c4f0f
--- /dev/null
+++ b/tests/test/cpu16/i8086/tmml.pp
@@ -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}
+.
\ No newline at end of file