Prechádzať zdrojové kódy

+ added test for the i8086 compact model memory layout

git-svn-id: trunk@28050 -
nickysn 11 rokov pred
rodič
commit
3952f8830c
2 zmenil súbory, kde vykonal 64 pridanie a 0 odobranie
  1. 1 0
      .gitattributes
  2. 63 0
      tests/test/cpu16/i8086/tmmc.pp

+ 1 - 0
.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/tmmc.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

+ 63 - 0
tests/test/cpu16/i8086/tmmc.pp

@@ -0,0 +1,63 @@
+{ %cpu=i8086 }
+
+{ Memory layout test for the compact memory model.
+
+  Note that this test is NOT compatible with Turbo Pascal 3, despite the fact
+  that TP3 uses the compact memory model. The difference is that TP3 puts the
+  heap before the stack (i.e. at lower addresses than the stack). FPC for i8086
+  in the compact memory model follows TP7's large memory model data layout,
+  which means stack goes before the heap. In practice, this shouldn't matter for
+  most programs. }
+
+{$IFNDEF FPC_MM_COMPACT}
+  {$DEFINE SKIP_TEST}
+{$ENDIF not FPC_MM_COMPACT}
+
+{$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}
+.