mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 01:29:28 +02:00
130 lines
2.7 KiB
ObjectPascal
130 lines
2.7 KiB
ObjectPascal
{%skiptarget=wince}
|
|
{%delfiles=targ1a}
|
|
|
|
{ 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 msdos}
|
|
{$define HasExeSuffix}
|
|
{$define DosMaxArg}
|
|
{$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
|
|
Prefix =
|
|
{$ifdef Unix}
|
|
'./'
|
|
{$else}
|
|
''
|
|
{$endif}
|
|
;
|
|
ExeSuffix =
|
|
{$ifdef HasExeSuffix}
|
|
'.exe'
|
|
{$else}
|
|
{$ifdef HasNlmSuffix}
|
|
'.nlm'
|
|
{$else}
|
|
''
|
|
{$endif}
|
|
{$endif}
|
|
;
|
|
const
|
|
MAX = 255;
|
|
|
|
{$ifdef DosMaxArg}
|
|
OK_L = 126;
|
|
{$else not DosMaxArg}
|
|
OK_L = 200;
|
|
{$endif not DosMaxArg}
|
|
|
|
var
|
|
cmd,
|
|
arg,arg2_length_string,args : string;
|
|
i, first, first_wrong,arg2_length,total_length : longint;
|
|
const
|
|
Everything_ok : boolean = true;
|
|
begin
|
|
cmd:=Prefix+'targ1a'+ExeSuffix;
|
|
arg:='';
|
|
first_wrong:=-1;
|
|
if paramcount>0 then
|
|
begin
|
|
val(paramstr(1),first);
|
|
for i:=1 to first do
|
|
arg:=arg+'a';
|
|
end
|
|
else
|
|
first:=0;
|
|
for i:=first to MAX - 4 { 4 chars needed for first arg and space } do
|
|
begin
|
|
arg2_length:=length(arg);
|
|
Writeln(stderr,'Going to call "',cmd,'" with arg2 = "',arg,'"');
|
|
Writeln(stderr,'arg2 length =',arg2_length);
|
|
str(arg2_length, arg2_length_string);
|
|
args:=arg2_length_string+' '+arg;
|
|
total_length:=length(args);
|
|
Writeln(stderr,'Length of all args=',total_length);
|
|
Exec(cmd,args);
|
|
if (DosExitCode<>0) or (DosError<>0) then
|
|
begin
|
|
if DosError<>0 then
|
|
Writeln(stderr,'Dos.Exec error detected, DosError=', DosError)
|
|
else
|
|
Writeln(stderr,'Error running targ1a, DosExitCode=',DosExitCode);
|
|
if first_wrong=-1 then
|
|
first_wrong:=total_length;
|
|
Everything_ok := false;
|
|
break;
|
|
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<OK_L then
|
|
RunError(1)
|
|
else
|
|
Writeln(stderr,'Warning: when using Dos.Exec, arg length must be smaller than ',first_wrong);
|
|
end;
|
|
end.
|
|
|