+ add test case for go32v2 memory corruption

git-svn-id: trunk@7005 -

.gitattributes

@@ -6731,6 +6731,7 @@ tests/test/tenum2.pp svneol=native#text/plain
 tests/test/testcmem.pp svneol=native#text/plain
 tests/test/testda1.pp svneol=native#text/plain
 tests/test/testfpuc.pp svneol=native#text/plain
+tests/test/testmem.pp -text
 tests/test/testmovd.pp svneol=native#text/plain
 tests/test/tests.pp svneol=native#text/plain
 tests/test/testsse2.pp svneol=native#text/plain
@@ -6907,6 +6908,7 @@ tests/test/tstrreal1.pp svneol=native#text/plain
 tests/test/tstrreal2.pp svneol=native#text/plain
 tests/test/tstrreal3.pp -text
 tests/test/tsubdecl.pp svneol=native#text/plain
+tests/test/ttestmem.pp -text
 tests/test/tugeneric7.pp svneol=native#text/plain
 tests/test/tunaligned1.pp svneol=native#text/plain
 tests/test/tunit1.pp svneol=native#text/plain

tests/test/testmem.pp

@@ -0,0 +1,31 @@
+program go32v2_crash;
+
+const
+  MAX_SIZE = 256;
+  SIZE_INC = 8;
+
+type
+  TMemArray = array [0..MAX_SIZE div SIZE_INC] of pointer;
+
+var
+  i : longint;
+  MemArray : TMemArray;
+
+function Size(i: longint) : longint;
+begin
+  Size:=1+SIZE_INC*i;
+end;
+
+begin
+  FillChar(MemArray,Sizeof(MemArray),#0);
+  for i:=0 to MAX_SIZE div SIZE_INC do
+    begin
+      GetMem(MemArray[i],Size(i));
+    end;
+  for i:=1 to MAX_SIZE div SIZE_INC do
+    begin
+      FreeMem(MemArray[i],Size(i));
+    end;
+  Writeln(stderr,'Everthing is fine');
+
+end.

tests/test/ttestmem.pp

@@ -0,0 +1,92 @@
+{ This file is to check if there is some memory corruption
+  due to startup code with argument loading
+  go32v2 target had this problem
+  close to 2.2 release 2007-03-27 pierre }
+
+program create_startup_test_crash;
+
+{$ifdef go32v2}
+{$define HasExeSuffix}
+{$endif}
+{$ifdef win32}
+{$define HasExeSuffix}
+{$endif}
+{$ifdef win64}
+{$define HasExeSuffix}
+{$endif}
+{$ifdef wince}
+{$define HasExeSuffix}
+{$endif}
+{$ifdef os2}
+{$define HasExeSuffix}
+{$endif}
+{$ifdef emx}
+{$define HasExeSuffix}
+{$endif}
+{$ifdef wdosx}
+{$define HasExeSuffix}
+{$endif}
+{$ifdef netware}
+{$define HasNlmSuffix}
+{$endif}
+{$ifdef netwlibc}
+{$define HasNlmSuffix}
+{$endif}
+
+uses
+  dos;
+
+const
+  ExeSuffix =
+{$ifdef HasExeSuffix}
+  '.exe'
+{$else}
+  {$ifdef HasNlmSuffix}
+    '.nlm'
+  {$else}
+    ''
+  {$endif}
+{$endif}
+  ;
+const
+  MAX = 255;
+
+var
+  cmd,
+  arg : string;
+  i, first_wrong : longint;
+const
+  Everything_ok : boolean = true;
+begin
+  cmd:='testmem'+ExeSuffix;
+  arg:='';
+  first_wrong:=-1;
+  for i:=0 to MAX do
+    begin
+      Writeln(stderr,'Going to call "',cmd,'" with arg = "',arg,'"');
+      Writeln(stderr,'arg length =',length(arg));
+      Exec(cmd,arg);
+      if (DosExitCode<>0) or (DosError<>0) then
+        begin
+          Writeln(stderr,'Crash detected');
+          if first_wrong=-1 then
+            first_wrong:=i;
+          Everything_ok := false;
+        end;
+      arg:=arg+'a';
+    end;
+  if Everything_ok then
+    begin
+      Writeln(stderr,'Test successful: no memory corruption occurs');
+    end
+  else
+    begin
+      Writeln(stderr,'Test fails: Memory corruption occurs');
+      Writeln(stderr,'First arg length where error appears is ',first_wrong);
+      if first_wrong<100 then
+        RunError(1)
+      else
+        Writeln(stderr,'Warning: when using Dos.Exec, arg length must be smaller than ',first_wrong);
+    end;
+end.
+