mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 10:40:13 +02:00
+ dummy added to keep darwin dir alive
This commit is contained in:
parent
c1a43ddf5d
commit
326a427da1
117
fcl/darwin/process.inc
Normal file
117
fcl/darwin/process.inc
Normal file
@ -0,0 +1,117 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2000 by Michael Van Canneyt
|
||||
|
||||
Darwin specific part of TProcess.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
uses
|
||||
{$ifdef ver1_0}
|
||||
Linux
|
||||
{$else}
|
||||
Unix
|
||||
{$endif}
|
||||
;
|
||||
|
||||
Function TProcess.GetRunning : Boolean;
|
||||
|
||||
begin
|
||||
IF FRunning then
|
||||
FRunning:=GetExitStatus=-1;
|
||||
Result:=FRunning;
|
||||
end;
|
||||
|
||||
Procedure TProcess.Execute;
|
||||
|
||||
begin
|
||||
FreeStreams;
|
||||
CreatePipeStreams (FChildInputSTream,FParentOutPutStream);
|
||||
CreatePipeStreams (FParentInputStream,FChildOutPutStream);
|
||||
If poUsePipes in FCreateOptions then
|
||||
begin
|
||||
if poStdErrToOutPut in FCreateOptions then
|
||||
CreatePipeStreams (FParentErrorStream,FChildErrorStream)
|
||||
else
|
||||
begin
|
||||
FChildErrorStream:=FChildOutPutStream;
|
||||
FParentErrorStream:=FParentInputStream;
|
||||
end;
|
||||
end
|
||||
else
|
||||
CreatePipeStreams (FParentErrorStream,FChildErrorStream);
|
||||
If FCurrentDirectory<>'' then
|
||||
Chdir(FCurrentDirectory);
|
||||
FHandle:=fork();
|
||||
if FHandle=0 then
|
||||
begin
|
||||
// Child
|
||||
fdClose(0);
|
||||
fdClose(1);
|
||||
fdclose(2);
|
||||
dup2(FChildInputStream.Handle,0);
|
||||
dup2(FCHildOutputStream.Handle,1);
|
||||
dup2(FChildErrorStream.Handle,2);
|
||||
execl(FCommandline);
|
||||
halt(127);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Parent
|
||||
FPID:=FHandle;
|
||||
FThreadHandle:=FHandle;
|
||||
fdclose(FChildOutputStream.Handle);
|
||||
fdclose(FChildInputStream.Handle);
|
||||
fdclose(FChildErrorStream.Handle);
|
||||
FRunning:=True;
|
||||
if (poWaitOnExit in FCreateOptions) and
|
||||
not (poRunSuspended in FCreateOptions) then
|
||||
WaitOnExit;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TProcess.WaitOnExit : Dword;
|
||||
|
||||
begin
|
||||
waitpid(FPID, nil, 0);
|
||||
{
|
||||
Result:=WaitForSingleObject (FprocessInformation.hProcess,Infinite);
|
||||
If Result<>Wait_Failed then
|
||||
GetExitStatus;
|
||||
} FRunning:=False;
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
Function TProcess.Suspend : Longint;
|
||||
|
||||
begin
|
||||
Result:=Kill(Handle,SIGSTOP);
|
||||
end;
|
||||
|
||||
Function TProcess.Resume : LongInt;
|
||||
|
||||
begin
|
||||
Result:=Kill(FHandle,SIGCONT);
|
||||
end;
|
||||
|
||||
Function TProcess.Terminate(AExitCode : Integer) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
If ExitStatus=-1 then
|
||||
Result:=Kill(FHandle,SIGTERM)=0;
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-02-25 17:06:39 florian
|
||||
+ dummy added to keep darwin dir alive
|
||||
}
|
Loading…
Reference in New Issue
Block a user