paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 11:46:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

* udpated for dos

Browse Source
This commit is contained in:
peter 2001-07-01 20:13:50 +00:00
parent 268d2a4ab6
commit f8501c3d4f
1 changed files with 32 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
tests/utils/redir.pp
View File

@ -87,6 +87,13 @@ Uses
{$endif unix}
dos;
Const
{$ifdef UNIX}
DirSep='/';
{$else UNIX}
DirSep='\';
{$endif UNIX}
var
FIN,FOUT,FERR : ^File;
RedirChangedOut,
@ -94,6 +101,25 @@ var
RedirChangedError : Boolean;
InRedirDisabled,OutRedirDisabled,ErrorRedirDisabled : Boolean;
{*****************************************************************************
Helpers
*****************************************************************************}
function FixPath(const s:string):string;
var
i : longint;
begin
{ Fix separator }
for i:=1 to length(s) do
if s[i] in ['/','\'] then
fixpath[i]:=DirSep
else
fixpath[i]:=s[i];
fixpath[0]:=s[0];
end;
{*****************************************************************************
Dos
*****************************************************************************}
@ -686,7 +712,7 @@ end;
{ Must use shell() for linux for the wildcard expansion (PFV) }
{$ifdef UNIX}
IOStatus:=0;
ExecuteResult:=Shell(Progname+' '+Comline);
ExecuteResult:=Shell(FixPath(Progname)+' '+Comline);
{ Signal that causes the stop of the shell }
IOStatus:=ExecuteResult and $7F;
{ Exit Code seems to be in the second byte,
@ -699,7 +725,7 @@ end;
ExecInheritsHandles:=true;
{$endif win32}
DosError:=0;
Dos.Exec (Getenv('COMSPEC'),'/C '+progname+' '+Comline);
Dos.Exec (Getenv('COMSPEC'),'/C '+FixPath(progname)+' '+Comline);
{$ifdef win32}
ExecInheritsHandles:=StoreInherit;
{$endif win32}
@ -731,7 +757,10 @@ finalization
End.
{
$Log$
Revision 1.5 2001-02-03 00:13:34 peter
Revision 1.6 2001-07-01 20:13:50 peter
* udpated for dos
Revision 1.5 2001/02/03 00:13:34 peter
* linux -> unix for not 1.0.x compilers
Revision 1.4 2000/12/10 12:08:11 peter