← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to fcl/freebsd/process.inc

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/freebsd/process.inc
1
 
{
2
 
    $Id: process.inc,v 1.5 2002/09/07 15:15:24 peter Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2000 by Michael Van Canneyt
5
 
 
6
 
    Linux specific part of TProcess.
7
 
 
8
 
    See the file COPYING.FPC, included in this distribution,
9
 
    for details about the copyright.
10
 
 
11
 
    This program is distributed in the hope that it will be useful,
12
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
 
 
15
 
 **********************************************************************}
16
 
 
17
 
uses
18
 
{$ifdef ver1_0}
19
 
  Linux
20
 
{$else}
21
 
  Unix
22
 
{$endif}
23
 
  ;
24
 
 
25
 
Function TProcess.GetRunning : Boolean;
26
 
 
27
 
begin
28
 
  IF FRunning then
29
 
    FRunning:=GetExitStatus=-1;
30
 
  Result:=FRunning;
31
 
end;
32
 
 
33
 
Procedure TProcess.Execute;
34
 
 
35
 
begin
36
 
  FreeStreams;
37
 
  CreatePipeStreams (FChildInputSTream,FParentOutPutStream);
38
 
  CreatePipeStreams (FParentInputStream,FChildOutPutStream);
39
 
  If poUsePipes in FCreateOptions then
40
 
    begin
41
 
    if poStdErrToOutPut in FCreateOptions then
42
 
      CreatePipeStreams (FParentErrorStream,FChildErrorStream)
43
 
    else
44
 
      begin
45
 
      FChildErrorStream:=FChildOutPutStream;
46
 
      FParentErrorStream:=FParentInputStream;
47
 
      end;
48
 
    end
49
 
  else
50
 
    CreatePipeStreams (FParentErrorStream,FChildErrorStream);
51
 
  If FCurrentDirectory<>'' then
52
 
    Chdir(FCurrentDirectory);
53
 
  FHandle:=fork();
54
 
  if FHandle=0 then
55
 
   begin
56
 
   // Child
57
 
   fdClose(0);
58
 
   fdClose(1);
59
 
   fdclose(2);
60
 
   dup2(FChildInputStream.Handle,0);
61
 
   dup2(FCHildOutputStream.Handle,1);
62
 
   dup2(FChildErrorStream.Handle,2);
63
 
   execl(FCommandline);
64
 
   halt(127);
65
 
   end
66
 
  else
67
 
    begin
68
 
    // Parent
69
 
    FPID:=FHandle;
70
 
    FThreadHandle:=FHandle;
71
 
    fdclose(FChildOutputStream.Handle);
72
 
    fdclose(FChildInputStream.Handle);
73
 
    fdclose(FChildErrorStream.Handle);
74
 
    FRunning:=True;
75
 
    if (poWaitOnExit in FCreateOptions) and
76
 
        not (poRunSuspended in FCreateOptions) then
77
 
    WaitOnExit;
78
 
    end;
79
 
end;
80
 
 
81
 
Function TProcess.WaitOnExit : Dword;
82
 
 
83
 
begin
84
 
  waitpid(FPID, nil, 0);
85
 
{
86
 
  Result:=WaitForSingleObject (FprocessInformation.hProcess,Infinite);
87
 
  If Result<>Wait_Failed then
88
 
    GetExitStatus;
89
 
}  FRunning:=False;
90
 
  Result := 0;
91
 
end;
92
 
 
93
 
Function TProcess.Suspend : Longint;
94
 
 
95
 
begin
96
 
  Result:=Kill(Handle,SIGSTOP);
97
 
end;
98
 
 
99
 
Function TProcess.Resume : LongInt;
100
 
 
101
 
begin
102
 
  Result:=Kill(FHandle,SIGCONT);
103
 
end;
104
 
 
105
 
Function TProcess.Terminate(AExitCode : Integer) : Boolean;
106
 
 
107
 
begin
108
 
  Result:=False;
109
 
  If ExitStatus=-1 then
110
 
    Result:=Kill(FHandle,SIGTERM)=0;
111
 
end;
112
 
 
113
 
{
114
 
  $Log: process.inc,v $
115
 
  Revision 1.5  2002/09/07 15:15:24  peter
116
 
    * old logs removed and tabs fixed
117
 
 
118
 
}