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

git-svn-id: trunk@28040 -

.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

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}
+.