paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 17:19:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* changed sysutils.exec to ExecuteProcess

Browse Source
This commit is contained in:
florian 2004-01-05 22:37:15 +00:00
parent 736c418d14
commit 822ce0df68
4 changed files with 75 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
compiler/utils/fpc.pp
View File

@ -113,7 +113,7 @@ program fpc;
ppcbin:='ppcppc';
processorname:='powerpc';
{$endif powerpc}
versionstr:=''; { Default is just the name }
versionstr:=''; { Default is just the name }
for i:=1 to paramcount do
begin
s:=paramstr(i);
@ -134,51 +134,51 @@ program fpc;
writeln(ppcbin);
halt(0);
end
{ -PP is a special code that will show the
processor and exit immediatly. It's
main usage is for Makefile }
else if processorstr='P' then
begin
{ report the processor }
writeln(processorname);
halt(0);
end
else if processorstr='i386' then
ppcbin:='ppc386'
else if processorstr='m68k' then
ppcbin:='ppc68k'
else if processorstr='alpha' then
ppcbin:='ppcapx'
else if processorstr='powerpc' then
ppcbin:='ppcppc'
else error('Illegal processor type "'+processorstr+'"');
end
else
ppccommandline:=ppccommandline+s+' ';
end;
{ -PP is a special code that will show the
processor and exit immediatly. It's
main usage is for Makefile }
else if processorstr='P' then
begin
{ report the processor }
writeln(processorname);
halt(0);
end
else if processorstr='i386' then
ppcbin:='ppc386'
else if processorstr='m68k' then
ppcbin:='ppc68k'
else if processorstr='alpha' then
ppcbin:='ppcapx'
else if processorstr='powerpc' then
ppcbin:='ppcppc'
else error('Illegal processor type "'+processorstr+'"');
end
else
ppccommandline:=ppccommandline+s+' ';
end;
end;
if versionstr<>'' then
ppcbin:=ppcbin+'-'+versionstr;
ppcbin:=ppcbin+'-'+versionstr;
{ find the full path to the specified exe }
findexe(ppcbin);
{ call ppcXXX }
swapvectors;
{$ifdef unix}
errorvalue:=SysUtils.exec(ppcbin,ppccommandline);
{$else}
Dos.exec(ppcbin,ppccommandline);
errorvalue:=doserror;
{$endif}
swapvectors;
try
errorvalue:=ExecuteProcess(ppcbin,ppccommandline);
except
error(ppcbin+' can''t be executed');
end;
if errorvalue<>0 then
error(ppcbin+' can''t be executed');
halt(dosexitcode);
end.
{
$Log$
Revision 1.10 2004-01-03 09:20:45 marco
Revision 1.11 2004-01-05 22:41:20 florian
* changed sysutils.exec to ExecuteProcess
Revision 1.10 2004/01/03 09:20:45 marco
* errorhandling fixed
Revision 1.9 2004/01/03 09:12:23 marco

11
rtl/objpas/sysutils/osutilsh.inc
View File

@ -16,13 +16,14 @@
{ OS handling utilities }
Function GetEnvironmentVariable(Const EnvVar : String) : String;
{$ifdef HAS_EXEC_ANSI} // define is temporarily.
function Exec (Const Path: AnsiString; Const ComLine: AnsiString):integer;
{$endif}
function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
{
$Log$
Revision 1.2 2004-01-03 08:55:58 marco
Revision 1.3 2004-01-05 22:37:24 florian
* changed sysutils.exec to ExecuteProcess
Revision 1.2 2004/01/03 08:55:58 marco
* Exec(ansistring) function
Revision 1.1 2003/10/06 21:01:06 peter
@ -31,4 +32,4 @@ function Exec (Const Path: AnsiString; Const ComLine: AnsiString):integer;
Revision 1.3 2002/09/07 16:01:22 peter
* old logs removed and tabs fixed
}
}

14
rtl/objpas/sysutils/sysutilh.inc
View File

@ -140,7 +140,7 @@ type
EAbort = Class(Exception);
EAbstractError = Class(Exception);
EAssertionFailed = Class(Exception);
EPropReadOnly = class(Exception);
EPropWriteOnly = class(Exception);
@ -150,6 +150,11 @@ type
EPackageError = class(Exception);
EOSError = class(Exception)
public
ErrorCode: DWORD;
end;
ESafecallException = class(Exception);
ENoThreadSupport = Class(Exception);
@ -167,7 +172,7 @@ type
type
TTerminateProc = function: Boolean;
procedure AddTerminateProc(TermProc: TTerminateProc);
function CallTerminateProcs: Boolean;
@ -226,7 +231,10 @@ Type
{
$Log$
Revision 1.5 2003-11-26 22:17:42 michael
Revision 1.6 2004-01-05 22:37:24 florian
* changed sysutils.exec to ExecuteProcess
Revision 1.5 2003/11/26 22:17:42 michael
+ Merged fixbranch fixes, missing in main branch
Revision 1.4 2003/11/26 20:12:08 michael

40
rtl/unix/sysutils.pp
View File

@ -21,7 +21,7 @@ interface
{ force ansistrings }
{$H+}
{$DEFINE HAS_EXEC_ANSI}
{$DEFINE HAS_EXEC_ANSI}
uses
Unix,errors,sysconst;
@ -478,36 +478,43 @@ begin
Result:=StrPas(BaseUnix.FPGetenv(PChar(EnvVar)));
end;
function Exec (Const Path: AnsiString; Const ComLine: AnsiString):integer;
function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
var
pid : longint;
err : longint;
// The Error-Checking in the previous Version failed, since halt($7F) gives an WaitPid-status of $7
e : EOSError;
Begin
pid:=fpFork;
pid:=fpFork;
if pid=0 then
begin
{The child does the actual exec, and then exits}
if ComLine='' then
Execl(Path)
if ComLine='' then
Execl(Path)
else
Execl(Path+' '+ComLine);
{If the execve fails, we return an exitvalue of 127, to let it be known}
Execl(Path+' '+ComLine);
{ If the execve fails, we return an exitvalue of 127, to let it be known}
fpExit(127);
end
else
if pid=-1 then {Fork failed}
begin
result:=8;
exit
e:=EOSError.CreateFmt('Failed to execute %s : %d',[CommandLine,-1]);
e.ErrorCode:=-1;
raise e;
end;
{We're in the parent, let's wait.}
{ We're in the parent, let's wait. }
result:=WaitProcess(pid); // WaitPid and result-convert
if (result>=0) and (result<>127) then
result:=0
result:=0
else
result:=8; // perhaps one time give an better error
begin
e:=EOSError.CreateFmt('Failed to execute %s : %d',[CommandLine,result]);
e.ErrorCode:=result;
raise e;
end;
End;
@ -524,7 +531,10 @@ end.
{
$Log$
Revision 1.27 2004-01-03 09:09:11 marco
Revision 1.28 2004-01-05 22:37:15 florian
* changed sysutils.exec to ExecuteProcess
Revision 1.27 2004/01/03 09:09:11 marco
* Unix exec(ansistring)
Revision 1.26 2003/11/26 20:35:14 michael
@ -572,4 +582,4 @@ end.
Revision 1.12 2002/01/25 16:23:03 peter
* merged filesearch() fix
}
}