Merged revisions 7005-7006 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r7005 | pierre | 2007-03-27 11:17:33 +0200 (Tue, 27 Mar 2007) | 1 line
  
   + add test case for go32v2 memory corruption
........
  r7006 | pierre | 2007-03-27 12:15:07 +0200 (Tue, 27 Mar 2007) | 1 line
  
   new tests renamed as suggested by Peter
........

git-svn-id: branches/fixes_2_2@7160 -

.gitattributes

@@ -6621,6 +6621,8 @@ tests/test/taddstr1.pp svneol=native#text/plain
 tests/test/talign.pp svneol=native#text/plain
 tests/test/talign1.pp svneol=native#text/plain
 tests/test/talign2.pp svneol=native#text/plain
+tests/test/targ1a.pp -text
+tests/test/targ1b.pp -text
 tests/test/tarray1.pp svneol=native#text/plain
 tests/test/tarray2.pp svneol=native#text/plain
 tests/test/tarray3.pp svneol=native#text/plain

tests/test/targ1a.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/targ1b.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:='targ1a'+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.
+