فهرست منبع

Merge branch 'extended_process'

Michaël Van Canneyt 1 سال پیش
والد
کامیت
75f20c086a

+ 106 - 18
packages/fcl-process/src/amicommon/process.inc

@@ -14,6 +14,8 @@
 
  **********************************************************************}
 
+{$DEFINE OS_HASCREATEPIPE}
+
 {$IFDEF FPC_DOTTEDUNITS}
 uses
   Amiga.Core.Exec, Amiga.Core.Amigados, Amiga.Core.Utility;
@@ -71,6 +73,7 @@ begin
   Result := WStart;
 end;
 
+
 function MaybeQuote (const S: ansistring): ansistring;
 begin
   if (Pos (' ', S) <> 0) then
@@ -89,14 +92,14 @@ const
   BUF_NONE = 2; // no buffering
 {$endif}
 
-Procedure TProcess.Execute;
+Procedure TProcess.SysExecute;
 var
   I: integer;
   ExecName, FoundName: ansistring;
   E2: EProcess;
   OrigDir: ansistring;
   Cmd,Params: ansistring;
-  TempName: ansistring;
+  TempName,OTempName: ansistring;
   cos: BPTR;
   {$ifdef MorphOS}
   inA, inB, OutA, OutB: BPTR;
@@ -144,16 +147,30 @@ begin
    end;
   try
     {$ifdef MorphOS}
-    if (poUsePipes in Options) and (not (poWaitOnExit in Options)) then
+    if poUsePipes in Options then
+    begin
+      FDescriptors[phtInput].PrepareHandles;
+      FDescriptors[phtOutput].PrepareHandles;
+      //FDescriptors[phtError].PrepareHandles;
+    end;
+    if (not (poWaitOnExit in Options)) then
     begin
       FProcessID := 0;
-      // Pipenames, should be unique
-      TempName := 'PIPE:PrO_' + HexStr(Self) + HexStr(GetTickCount, 8);
-      inA := DOSOpen(PAnsiChar(TempName), MODE_OLDFILE);
-      inB := DOSOpen(PAnsiChar(TempName), MODE_NEWFILE);
-      TempName := TempName + 'o';
-      outA := DOSOpen(PAnsiChar(TempName), MODE_OLDFILE);
-      outB := DOSOpen(PAnsiChar(TempName), MODE_NEWFILE);
+        // MVC : IMO this should go to CreatePipes.
+     if (FDescriptors[phtInput].IOType=iotPipe) then
+       begin
+       // Read handle
+       InB:=FDescriptors[phtInput].FTheirHandle;
+       // Write handle
+       OutA:=FDescriptors[phtInput].FOurHandle;
+       end;
+     if (FDescriptors[phtOutput].IOType=iotPipe) then
+       begin
+       // Write handle
+       OutB:=FDescriptors[phtOutput].FTheirHandle;
+       // Read handle
+       InA:=FDescriptors[phtOutput].FOurHandle;
+       end;
       // set buffer for all pipes
       SetVBuf(inA, nil, BUF_NONE, -1);
       SetVBuf(inB, nil, BUF_LINE, -1);
@@ -161,8 +178,8 @@ begin
       SetVBuf(outB, nil, BUF_LINE, -1);
       // the actual Start of the command with given parameter and streams
       Res := SystemTags(PAnsiChar(ExecName + ' ' + Params),
-                        [SYS_Input, AsTag(outA),
-                         SYS_Output, AsTag(inB),
+                        [SYS_Input, AsTag(inB),
+                         SYS_Output, AsTag(outB),
                          SYS_Asynch, AsTag(True),
                          TAG_END]);
       // the two streams will be destroyed by system, we do not need to care about
@@ -170,15 +187,16 @@ begin
       if Res <> -1 then
       begin
         FProcessID := 1;
-        CreateStreams(THandle(outB), THandle(inA),0);
+        // Remove the Used Pipe end because they will be freed by the system
+        FDescriptors[phtInput].FTheirHandle := INVALID_HANDLE_VALUE;
+        FDescriptors[phtOutput].FTheirHandle := INVALID_HANDLE_VALUE;
+        // No longer needed, done in TIOFileDescriptor
+        // CreateStreams(THandle(outB), THandle(inA),0);
       end
       else
       begin
         // if the command did not start, we need to delete all Streams
-        if outB <> BPTR(0) then DosClose(outB);
-        if outA <> BPTR(0) then DosClose(outA);
-        if inB <> BPTR(0) then DosClose(inB);
-        if inA <> BPTR(0) then DosClose(inA);
+        // not needed to remove the pipes anymore the descriptors will care about that
       end;
     end
     else
@@ -195,7 +213,6 @@ begin
       cos := AmigaDos.DosOpen(PAnsiChar(TempName), MODE_READWRITE);
       FExitCode := LongInt(amigados.Execute(PAnsiChar(ExecName + ' ' + Params), BPTR(0), cos));
       DosSeek(cos, 0, OFFSET_BEGINNING);
-      CreateStreams(0, THandle(cos),0);
     end;
     //FExitCode := ExecuteProcess (ExecName, Params);
   except
@@ -240,4 +257,75 @@ Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);
 begin
 end;
 
+function TIODescriptor.SysNullFileName: string;
+begin
+//  result:='/dev/null';
+end;
+
+function TIODescriptor.SysIsTypeSupported(AValue: TIOType): Boolean;
+begin
+  Result:=True;
+end; 
+
+
+function TIODescriptor.SysCreateFileNameHandle(const aFileName: string): THandle;
+
+const
+  DefaultRights = 438; // 438 = 666 octal which is rw rw rw
+  ModeNames : Array[Boolean] of String = ('Reading','Writing');
+
+begin
+  if (aFileName='') then
+    Raise EProcess.Create('No filename provided');
+  case ProcessHandleType of
+    phtInput:  Result:=FileOpen(aFileName,fmOpenRead);
+    phtOutput,
+    phtError: if FileExists(aFileName) then
+                Result:=FileOpen(aFileName,fmOpenWrite or fmShareDenyNone)
+              else
+                Result:=FileCreate(aFileName,fmShareDenyNone,DefaultRights)
+  end;
+  if (Result=-1) then
+    Raise EProcess.CreateFmt('Could not open file "%s" for %s',[aFileName,ModeNames[ProcessHandleType<>phtInput]]);
+end;
+
+function TIODescriptor.SysCreatePipeHandle: THandle;
+
+var
+  TempName : AnsiString;
+  HIn,HOut : BPTR;
+  
+begin
+  // MVC : This should be moved to CreatePipeHandles.
+  TempName := 'PIPE:PrO_' + HexStr(Self) + HexStr(GetTickCount, 8);
+  if ProcessHandleType=phtInput then
+    TempName:=TempName+'i'
+  else  
+    TempName:=TempName+'o';
+  // Read handle
+  HIn := DOSOpen(PAnsiChar(TempName), MODE_OLDFILE);
+  // Write handle
+  HOut := DOSOpen(PAnsiChar(TempName), MODE_NEWFILE);
+  // Check correctness ?
+  //
+  // Set needed handkers
+  case ProcessHandleType of
+    phtInput:
+      begin
+      Result:=THandle(HIn);
+      FOurHandle:=THandle(hOut);
+      end;
+    phtOutput,
+    phtError:
+      begin
+      Result:=THandle(hOut);
+      FOurHandle:=THandle(HIn);
+      end;
+  end;
+  
+end;
 
+function TIODescriptor.SysPrepareCreatedHandleForProcess(aHandle: THandle): THandle;
+begin
+  Result:=aHandle;
+end;   

+ 10 - 1
packages/fcl-process/src/process.pp

@@ -60,9 +60,18 @@ Type
   TProcessForkEvent = procedure(Sender : TObject) of object;
   {$endif UNIX}
 
+  TIOType = (iotNone, iotPipe, iotFile, iotHandle, iotProcess, iotNull);
+  TProcessHandleType = (phtInput,phtOutput,phtError);
+
+  TGetHandleEvent = procedure(Sender : TObject; var aHandle : THandle; var CloseOnExecute : Boolean) of object;
+  TAfterAllocateHandleEvent = procedure(Sender : TObject; aHandle : THandle; var CloseOnExecute : Boolean) of object;
+
+  { TIODescriptor }
+  TProcess = Class;
+
 {$macro on}
 {define processunicodestring}
-{$define TProcessnamemacro:=TProcess}
 
 {$i processbody.inc}
+
 end.

+ 476 - 71
packages/fcl-process/src/processbody.inc

@@ -40,9 +40,76 @@ Type
    TProcessStringList = TStringList;
    {$endif}
 
+   TFileWriteMode = (fwmTruncate, fwmAppend, fwmAtstart);
+
+
+   TIODescriptor = class(TPersistent)
+   private
+     FAfterAllocateHandle: TAfterAllocateHandleEvent;
+     FCloseHandleOnExecute: Boolean;
+     FCustomHandle: THandle;
+     FFileWriteMode: TFileWriteMode;
+     FHandleType: TProcessHandleType;
+     FFileName: TFileName;
+     FIOType: TIOType;
+     FOnGetHandle: TGetHandleEvent;
+     FOwnerProcess: TProcess;
+     FPipeBufferSize: cardinal;
+     FProcess: TProcess;
+     FTheirHandle : THandle;
+     FTheirHandleIOType: TIOType;
+     FHandleValid : Boolean;
+     FStream : THandleStream;
+     FOurHandle : THandle;
+     procedure SetFileName(AValue: TFileName);
+     procedure SetFileWriteMode(AValue: TFileWriteMode);
+     procedure SetIOType(AValue: TIOType);
+     procedure SetProcess(AValue: TProcess);
+     function SysCreatePipeHandle: THandle;
+     function SysPrepareCreatedHandleForProcess(aHandle: THandle): THandle;
+     Function SysCreateFileNameHandle(const aFileName : string) : THandle;
+     function SysNullFileName : string;
+     function SysIsTypeSupported(AValue: TIOType) : Boolean;
+   protected
+     Procedure CheckNotRunning; virtual;
+     // Create handles for new process
+     Function PrepareCreatedHandleForProcess(aHandle : THandle) : THandle; virtual;
+     Function CreateStandardHandle : THandle; virtual;
+     Function CreatePipeHandle : THandle; virtual;
+     Function CreateFileNameHandle : THandle; virtual;
+     Function CreateNullFileHandle : THandle; virtual;
+     Function CreateCustomHandle : THandle; virtual;
+     Function CreateProcessHandle : THandle; virtual;
+     Function ResolveProcessHandle : THandle; virtual;
+     Function ResolveStream : THandleStream; virtual;
+     Procedure CloseOurHandle; virtual;
+     Procedure CloseTheirHandle(aForceClose : Boolean = false);virtual;
+     Procedure PrepareHandles;virtual;
+     Procedure ResetHandles;virtual;
+     Property OwnerProcess : TProcess Read FOwnerProcess;
+     Property PipeBufferSize : cardinal read FPipeBufferSize write FPipeBufferSize;
+     Property OurHandle: THandle Read FOurHandle;
+     Property HandleValid : Boolean Read FHandleValid;
+     Property CloseHandleOnExecute : Boolean Read FCloseHandleOnExecute Write FCloseHandleOnExecute;
+   public
+     Constructor Create(aOwnerProcess : TProcess; aType : TProcessHandleType);
+     Destructor Destroy; override;
+     Property ProcessHandleType : TProcessHandleType Read FHandleType;
+     Property CustomHandle : THandle Read FCustomHandle Write FCustomHandle;
+
+   Published
+     Property IOType : TIOType Read FIOType Write SetIOType;
+     Property FileName : TFileName Read FFileName Write SetFileName;
+     Property OnGetHandle : TGetHandleEvent Read FOnGetHandle Write FOnGetHandle;
+     Property AfterAllocateHandle : TAfterAllocateHandleEvent Read FAfterAllocateHandle Write FAfterAllocateHandle;
+     Property Process : TProcess Read FProcess Write SetProcess;
+     Property FileWriteMode : TFileWriteMode Read FFileWriteMode Write SetFileWriteMode;
+   end;
+
+
   { TProcess }
 
-  TProcessnamemacro = Class (TComponent)
+  TProcess = Class (TComponent)
   Private
     FOnRunCommandEvent: TOnRunCommandEvent;
     FProcessOptions : TProcessOptions;
@@ -71,13 +138,19 @@ Type
     dwy : Cardinal;
     FXTermProgram: String;
     FPipeBufferSize : cardinal;
-    Procedure FreeStreams;
+    FDescriptors: Array [TProcessHandleType] of TIODescriptor;
+    function GetDescriptor(AIndex: Integer): TIODescriptor;
     Function  GetExitStatus : Integer;
     Function  GetExitCode : Integer;
+    function GetInputStream: TOutputPipeStream;
+    function GetOutputStream: TInputPipeStream;
     Function  GetRunning : Boolean;
+    function GetStderrStream: TinputPipeStream;
     Function  GetWindowRect : TRect;
     procedure SetCommandLine(const AValue: TProcessString); deprecated;
+    procedure SetDescriptor(AIndex: Integer; AValue: TIODescriptor);
     procedure SetParameters(const AValue: TProcessStrings);
+    procedure SetPipeBufferSize(AValue: cardinal);
     Procedure SetWindowRect (Value : TRect);
     Procedure SetShowWindow (Value : TShowWindowOptions);
     Procedure SetWindowColumns (Value : Cardinal);
@@ -96,17 +169,14 @@ Type
   Protected
     FRunning : Boolean;
     FExitCode : Cardinal;
-    FInputStream  : TOutputPipeStream;
-    FOutputStream : TInputPipeStream;
-    FStderrStream : TInputPipeStream;
     FProcessID : Integer;
     FThreadID : Integer;
     FProcessHandle : Thandle;
     FThreadHandle : Thandle;
     procedure CloseProcessHandles; virtual;
-    Procedure CreateStreams(InHandle,OutHandle,ErrHandle : Longint);virtual;
-    procedure FreeStream(var AStream: THandleStream);
     procedure Loaded; override;
+    Procedure SysExecute; virtual;
+    function CreateIODescriptor(aOwner: TProcess; aHandleType: TProcessHandleType): TIODescriptor; virtual;
   Public
     Constructor Create (AOwner : TComponent);override;
     Destructor Destroy; override;
@@ -126,12 +196,12 @@ Type
     Property WindowRect : Trect Read GetWindowRect Write SetWindowRect;
     Property Handle : THandle Read FProcessHandle;
     Property ProcessHandle : THandle Read FProcessHandle;
-    Property ThreadHandle : THandle Read FThreadHandle;
+    Property ThreadHandle : THandle Read FProcessHandle;
     Property ProcessID : Integer Read FProcessID;
     Property ThreadID : Integer Read FThreadID;
-    Property Input  : TOutputPipeStream Read FInputStream;
-    Property Output : TInputPipeStream  Read FOutputStream;
-    Property Stderr : TinputPipeStream  Read FStderrStream;
+    Property Input  : TOutputPipeStream Read GetInputStream;
+    Property Output : TInputPipeStream  Read GetOutputStream;
+    Property Stderr : TinputPipeStream  Read GetStderrStream;
     Property ExitStatus : Integer Read GetExitStatus;
     Property ExitCode : Integer Read GetExitCode;
     Property InheritHandles : Boolean Read FInheritHandles Write FInheritHandles;
@@ -141,7 +211,7 @@ Type
     property OnForkEvent : TProcessForkEvent Read FForkEvent Write FForkEvent;
     {$endif UNIX}
   Published
-    property PipeBufferSize : cardinal read FPipeBufferSize write FPipeBufferSize default 1024;
+    property PipeBufferSize : cardinal read FPipeBufferSize write SetPipeBufferSize default 1024;
     Property Active : Boolean Read GetRunning Write SetActive;
     Property ApplicationName : TProcessString Read FApplicationName Write SetApplicationName; deprecated;
     Property CommandLine : TProcessString Read FCommandLine Write SetCommandLine ; deprecated;
@@ -164,9 +234,12 @@ Type
     Property WindowWidth : Cardinal Read dwXSize Write SetWindowWidth;
     Property FillAttribute : Cardinal read FFillAttribute Write FFillAttribute;
     Property XTermProgram : String Read FXTermProgram Write FXTermProgram;
+    Property InputDescriptor : TIODescriptor index Ord(phtInput) Read GetDescriptor Write SetDescriptor;
+    Property OutputDescriptor : TIODescriptor Index Ord(phtOutput) Read GetDescriptor Write SetDescriptor;
+    Property ErrorDescriptor : TIODescriptor Index Ord(phtError) Read GetDescriptor Write SetDescriptor;
   end;
 
-  TProcessClass = Class of TProcessnamemacro;
+  TProcessClass = Class of TProcess;
 
 Procedure CommandToList(S : TProcessString; List : TProcessStrings);
 
@@ -174,6 +247,7 @@ Procedure CommandToList(S : TProcessString; List : TProcessStrings);
 Var
   TryTerminals : Array of string;
   XTermProgram : String;
+  SignalWaitTime : Integer = 20; // Wait time in ms. after sending SIGTERM
   Function DetectXTerm : String;
 {$endif unix}
 
@@ -186,12 +260,17 @@ function RunCommand(const cmdline:TProcessString;out outputstring:string):boolea
 
 // Allows override of the class instantiated for RunCommand*.
 
-var DefaultTProcess : TProcessClass = TProcessnamemacro;
+var DefaultTProcess : TProcessClass = TProcess;
+
+Resourcestring
+  SErrCannotCreatePipes = 'Failed to create pipes';
 
 implementation
 
 {$i process.inc}
 
+
+
 Procedure CommandToList(S : TProcessString; List : TProcessStrings);
 
   Function GetNextWord : TProcessString;
@@ -250,7 +329,11 @@ begin
     end;
 end;
 
-Constructor TProcessnamemacro.Create (AOwner : TComponent);
+Constructor TProcess.Create (AOwner : TComponent);
+
+Var
+  HT : TProcessHandleType;
+
 begin
   Inherited;
   FProcessPriority:=ppNormal;
@@ -264,36 +347,56 @@ begin
   FParameters:=TProcessStringList.Create;
   FRunCommandSleepTime:=100;
   FOnRunCommandEvent:=@IntOnIdleSleep;
+  For HT in TProcessHandleType do
+    FDescriptors[HT]:=CreateIODescriptor(Self,HT)
 end;
 
-Destructor TProcessnamemacro.Destroy;
+Destructor TProcess.Destroy;
+
+Var
+  HT : TProcessHandleType;
 
 begin
   FParameters.Free;
   FEnvironment.Free;
-  FreeStreams;
   CloseProcessHandles;
+  For HT in TProcessHandleType do
+    FreeAndNil(FDescriptors[HT]);
   Inherited Destroy;
 end;
 
-Procedure TProcessnamemacro.FreeStreams;
+Function TProcess.CreateIODescriptor(aOwner : TProcess; aHandleType : TProcessHandleType) :TIODescriptor;
+
 begin
-  If FStderrStream<>FOutputStream then
-    FreeStream(THandleStream(FStderrStream));
-  FreeStream(THandleStream(FOutputStream));
-  FreeStream(THandleStream(FInputStream));
+  Result:=TIODescriptor.Create(aOwner,aHandleType);
 end;
 
+function TProcess.GetDescriptor(AIndex: Integer): TIODescriptor;
+begin
+  Result:=FDescriptors[TProcessHandleType(aIndex)];
+end;
 
-Function TProcessnamemacro.GetExitStatus : Integer;
+function TProcess.GetInputStream: TOutputPipeStream;
+begin
+  Result:=FDescriptors[phtInput].ResolveStream as TOutputPipeStream;
+end;
+
+function TProcess.GetOutputStream: TInputPipeStream;
+begin
+  Result:=FDescriptors[phtOutput].ResolveStream as TInputPipeStream;
+end;
+
+
+
+Function TProcess.GetExitStatus : Integer;
 
 begin
   GetRunning;
-  Result:=FExitCode;
+  Result:=Integer(FExitCode);
 end;
 
 {$IFNDEF OS_HASEXITCODE}
-Function TProcessnamemacro.GetExitCode : Integer;
+Function TProcess.GetExitCode : Integer;
 
 begin
   if Not Running then
@@ -303,7 +406,7 @@ begin
 end;
 {$ENDIF}
 
-Function TProcessnamemacro.GetRunning : Boolean;
+Function TProcess.GetRunning : Boolean;
 
 begin
   IF FRunning then
@@ -311,46 +414,46 @@ begin
   Result:=FRunning;
 end;
 
-
-Procedure TProcessnamemacro.CreateStreams(InHandle,OutHandle,ErrHandle : Longint);
-
-begin
-  FreeStreams;
-  FInputStream:=TOutputPipeStream.Create (InHandle);
-  FOutputStream:=TInputPipeStream.Create (OutHandle);
-  if Not (poStderrToOutput in FProcessOptions) then
-    FStderrStream:=TInputPipeStream.Create(ErrHandle);
-end;
-
-procedure TProcessnamemacro.FreeStream(var AStream: THandleStream);
+function TProcess.GetStderrStream: TinputPipeStream;
 begin
-  if AStream = nil then exit;
-  FreeAndNil(AStream);
+  Result:=FDescriptors[phtError].ResolveStream as TInputPipeStream;
 end;
 
-procedure TProcessnamemacro.Loaded;
+procedure TProcess.Loaded;
 begin
   inherited Loaded;
   If (csDesigning in ComponentState) and (FCommandLine<>'') then
     ConvertCommandLine;
 end;
 
-procedure TProcessnamemacro.CloseInput;
+Procedure TProcess.Execute;
+
+Var
+  HT : TProcessHandleType;
+
+begin
+  for HT in TProcessHandleType do
+    FDescriptors[HT].ResetHandles;
+  SysExecute;
+end;
+
+
+procedure TProcess.CloseInput;
 begin
-  FreeStream(THandleStream(FInputStream));
+  FDescriptors[phtInput].CloseOurHandle;
 end;
 
-procedure TProcessnamemacro.CloseOutput;
+procedure TProcess.CloseOutput;
 begin
-  FreeStream(THandleStream(FOutputStream));
+  FDescriptors[phtOutput].CloseOurHandle;
 end;
 
-procedure TProcessnamemacro.CloseStderr;
+procedure TProcess.CloseStderr;
 begin
-  FreeStream(THandleStream(FStderrStream));
+  FDescriptors[phtError].CloseOurHandle;
 end;
 
-Procedure TProcessnamemacro.SetWindowColumns (Value : Cardinal);
+Procedure TProcess.SetWindowColumns (Value : Cardinal);
 
 begin
   if Value<>0 then
@@ -359,7 +462,7 @@ begin
 end;
 
 
-Procedure TProcessnamemacro.SetWindowHeight (Value : Cardinal);
+Procedure TProcess.SetWindowHeight (Value : Cardinal);
 
 begin
   if Value<>0 then
@@ -367,7 +470,7 @@ begin
   dwYSize:=Value;
 end;
 
-Procedure TProcessnamemacro.SetWindowLeft (Value : Cardinal);
+Procedure TProcess.SetWindowLeft (Value : Cardinal);
 
 begin
   if Value<>0 then
@@ -375,7 +478,7 @@ begin
   dwx:=Value;
 end;
 
-Procedure TProcessnamemacro.SetWindowTop (Value : Cardinal);
+Procedure TProcess.SetWindowTop (Value : Cardinal);
 
 begin
   if Value<>0 then
@@ -383,14 +486,14 @@ begin
   dwy:=Value;
 end;
 
-Procedure TProcessnamemacro.SetWindowWidth (Value : Cardinal);
+Procedure TProcess.SetWindowWidth (Value : Cardinal);
 begin
   If (Value<>0) then
     Include(FStartupOptions,suoUseSize);
   dwXSize:=Value;
 end;
 
-Function TProcessnamemacro.GetWindowRect : TRect;
+Function TProcess.GetWindowRect : TRect;
 begin
   With Result do
     begin
@@ -401,7 +504,7 @@ begin
     end;
 end;
 
-procedure TProcessnamemacro.SetCommandLine(const AValue: TProcessString);
+procedure TProcess.SetCommandLine(const AValue: TProcessString);
 begin
   if FCommandLine=AValue then exit;
   FCommandLine:=AValue;
@@ -409,12 +512,27 @@ begin
     ConvertCommandLine;
 end;
 
-procedure TProcessnamemacro.SetParameters(const AValue: TProcessStrings);
+procedure TProcess.SetDescriptor(AIndex: Integer; AValue: TIODescriptor);
+begin
+  FDescriptors[TProcessHandleType(aIndex)].Assign(AValue);
+end;
+
+procedure TProcess.SetParameters(const AValue: TProcessStrings);
 begin
   FParameters.Assign(AValue);
 end;
 
-Procedure TProcessnamemacro.SetWindowRect (Value : Trect);
+procedure TProcess.SetPipeBufferSize(AValue: cardinal);
+var
+  HT: TProcessHandleType;
+begin
+  if FPipeBufferSize = AValue then Exit;
+  FPipeBufferSize := AValue;
+  for HT in TProcessHandleType do
+    FDescriptors[HT].PipeBufferSize:=AValue;
+end;
+
+Procedure TProcess.SetWindowRect (Value : Trect);
 begin
   Include(FStartupOptions,suoUseSize);
   Include(FStartupOptions,suoUsePosition);
@@ -428,7 +546,7 @@ begin
 end;
 
 
-Procedure TProcessnamemacro.SetWindowRows (Value : Cardinal);
+Procedure TProcess.SetWindowRows (Value : Cardinal);
 
 begin
   if Value<>0 then
@@ -436,7 +554,7 @@ begin
   dwYCountChars:=Value;
 end;
 
-procedure TProcessnamemacro.SetApplicationName(const Value: TProcessString);
+procedure TProcess.SetApplicationName(const Value: TProcessString);
 begin
   FApplicationName := Value;
   If (csDesigning in ComponentState) and
@@ -444,16 +562,27 @@ begin
     FCommandLine:=Value;
 end;
 
-procedure TProcessnamemacro.SetProcessOptions(const Value: TProcessOptions);
+procedure TProcess.SetProcessOptions(const Value: TProcessOptions);
+
+var
+  HT : TProcessHandleType;
+
 begin
   FProcessOptions := Value;
   If poNewConsole in FProcessOptions then
     Exclude(FProcessOptions,poNoConsole);
   if poRunSuspended in FProcessOptions then
     Exclude(FProcessOptions,poWaitOnExit);
+  if poUsePipes in FProcessOptions then
+    for HT in TProcessHandleType do
+      FDescriptors[HT].IOType:=iotPipe;
+  if poStderrToOutPut in FProcessOptions then
+    FDescriptors[phtError].IOType:=iotNone;
+  if poPassInput in FProcessOptions then
+    FDescriptors[phtInput].IOType:=iotNone;
 end;
 
-procedure TProcessnamemacro.SetActive(const Value: Boolean);
+procedure TProcess.SetActive(const Value: Boolean);
 begin
   if (Value<>GetRunning) then
     If Value then
@@ -462,12 +591,12 @@ begin
       Terminate(0);
 end;
 
-procedure TProcessnamemacro.SetEnvironment(const Value: TProcessStrings);
+procedure TProcess.SetEnvironment(const Value: TProcessStrings);
 begin
   FEnvironment.Assign(Value);
 end;
 
-procedure TProcessnamemacro.ConvertCommandLine;
+procedure TProcess.ConvertCommandLine;
 begin
   FParameters.Clear;
   CommandToList(FCommandLine,FParameters);
@@ -481,7 +610,7 @@ end;
 Const
   READ_BYTES = 65536; // not too small to avoid fragmentation when reading large files.
 
-function TProcessnamemacro.ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var data:string;MaxLoops:integer=10):boolean;
+function TProcess.ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var data:string;MaxLoops:integer=10):boolean;
 var Available, NumBytes: integer;
 begin
     Available:=P.NumBytesAvailable;
@@ -503,7 +632,7 @@ begin
       end;
 end;
 
-function TProcessnamemacro.ReadInputStream(p:TInputPipeStream;data:TStream;MaxLoops:integer=10):boolean;
+function TProcess.ReadInputStream(p:TInputPipeStream;data:TStream;MaxLoops:integer=10):boolean;
 const
   BufSize = 4096;
 var
@@ -524,7 +653,7 @@ begin
   end;
 end;
 
-procedure TProcessnamemacro.IntOnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
+procedure TProcess.IntOnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
 begin
   if status=RunCommandIdle then
     sleep(FRunCommandSleepTime);
@@ -533,7 +662,7 @@ end;
 // helperfunction that does the bulk of the work.
 // We need to also collect stderr output in order to avoid
 // lock out if the stderr pipe is full.
-function TProcessnamemacro.RunCommandLoop(out outputstring:string;
+function TProcess.RunCommandLoop(out outputstring:string;
                             out stderrstring:string; out anexitstatus:integer):integer;
 var
     bytesread : integer;
@@ -595,7 +724,7 @@ Const
 
 function RunCommandIndir(const curdir:TProcessString;const exename:TProcessString;const commands:array of TProcessString;out outputstring:string;out exitstatus:integer; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone):integer;
 Var
-    p : TProcessnamemacro;
+    p : TProcess;
     i : integer;
     ErrorString : String;
 begin
@@ -618,7 +747,7 @@ end;
 
 function RunCommandInDir(const curdir,cmdline:TProcessString;out outputstring:string):boolean; deprecated;
 Var
-    p : TProcessnamemacro;
+    p : TProcess;
     exitstatus : integer;
     ErrorString : String;
 begin
@@ -636,7 +765,7 @@ end;
 
 function RunCommandIndir(const curdir:TProcessString;const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone):boolean;
 Var
-    p : TProcessnamemacro;
+    p : TProcess;
     i,
     exitstatus : integer;
     ErrorString : String;
@@ -661,7 +790,7 @@ end;
 
 function RunCommand(const cmdline:TProcessString;out outputstring:String):boolean; deprecated;
 Var
-    p : TProcessnamemacro;
+    p : TProcess;
     exitstatus : integer;
     ErrorString : String;
 begin
@@ -677,7 +806,7 @@ end;
 
 function RunCommand(const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone):boolean;
 Var
-    p : TProcessnamemacro;
+    p : TProcess;
     i,
     exitstatus : integer;
     ErrorString : String;
@@ -758,4 +887,280 @@ begin
 end;
 {$endif}
 
+{ TIODescriptor }
+
+procedure TIODescriptor.SetFileName(AValue: TFileName);
+begin
+  if FileName=AValue then Exit;
+  CheckNotRunning;
+  FFileName:=AValue;
+  if aValue<>'' then
+    FIOType:=iotFile;
+end;
+
+procedure TIODescriptor.SetFileWriteMode(AValue: TFileWriteMode);
+begin
+  if FFileWriteMode=AValue then Exit;
+  CheckNotRunning;
+  FFileWriteMode:=AValue;
+end;
+
+procedure TIODescriptor.SetIOType(AValue: TIOType);
+
+var
+  S : String;
+
+begin
+  if FIOType=AValue then Exit;
+  CheckNotRunning;
+  if not SysIsTypeSupported(aValue) then
+    begin
+    WriteStr(S,aValue);
+    Raise EProcess.CreateFmt('I/O Type "%s" not supported on this platform',[S]);
+    end;
+  FIOType:=AValue;
+  // Some cleanup
+  if aValue<>iotProcess then
+    FProcess:=Nil;
+  if aValue<>iotFile then
+    FFileName:='';
+end;
+
+procedure TIODescriptor.SetProcess(AValue: TProcess);
+
+begin
+  if FProcess=AValue then Exit;
+  CheckNotRunning;
+  if (FOwnerProcess=FProcess) then
+    Raise EProcess.Create('Remote process cannot refer to self process');
+  if Assigned(FOwnerProcess) and Assigned(FProcess) then
+    FProcess.RemoveComponent(FOwnerProcess);
+  if (aValue<>Nil) then
+    FIOType:=iotProcess;
+  FProcess:=AValue;
+  if Assigned(FOwnerProcess) and Assigned(FProcess) then
+    FProcess.RemoveComponent(FOwnerProcess);
+  if Self.ProcessHandleType=phtInput then
+    FProcess.OutputDescriptor.IOType:=iotPipe
+  else
+    FProcess.InputDescriptor.IOType:=iotPipe;
+end;
+
+
+procedure TIODescriptor.CheckNotRunning;
+begin
+  If Assigned(FOwnerProcess) then
+    if FOwnerProcess.Active then
+       Raise EProcess.Create('Cannot perform operation while process is running');
+end;
+
+function TIODescriptor.PrepareCreatedHandleForProcess(aHandle: THandle): THandle;
+begin
+  Result:=SysPrepareCreatedHandleForProcess(aHandle);
+end;
+
+Function TIODescriptor.CreateStandardHandle : THandle;
+
+begin
+  case ProcessHandleType of
+    phtInput:  Result:=StdInputHandle;
+    phtOutput:  Result:=StdOutputHandle;
+    phtError:  Result:=StdErrorHandle;
+  end;
+end;
+
+Function TIODescriptor.CreatePipeHandle : THandle;
+
+begin
+  Result:=SysCreatePipeHandle;
+end;
+
+{$IFNDEF OS_HASCREATEPIPE}
+Function TIODescriptor.SysCreatePipeHandle : THandle;
+
+var
+  HIn,HOut : Thandle;
+begin
+  HIn:=THandle(INVALID_HANDLE_VALUE);
+  HOut:=HIn;
+  If not CreatePipeHandles(Hin,HOut) then
+    Raise EProcess.Create(SErrCannotCreatePipes);
+  case ProcessHandleType of
+    phtInput:
+      begin
+      Result:=HIn;
+      FOurHandle:=hOut;
+      end;
+    phtOutput,
+    phtError:
+      begin
+      Result:=hOut;
+      FOurHandle:=HIn;
+      end;
+  end;
+end;
+{$ENDIF}
+
+Function TIODescriptor.CreateFileNameHandle : THandle;
+
+begin
+  Result:=SysCreateFileNameHandle(FileName);
+  if (ProcessHandleType<>phtInput) then
+    case FFileWriteMode of
+      fwmAtstart: ;
+      fwmTruncate : FileTruncate(Result,0);
+      fwmAppend : FileSeek(Result,0,soFromEnd);
+    end;
+end;
+
+function TIODescriptor.CreateNullFileHandle: THandle;
+begin
+  Result:=SysCreateFileNameHandle(SysNullFileName);
+end;
+
+Function TIODescriptor.CreateCustomHandle : THandle;
+
+begin
+  Result:=FCustomHandle;
+  if Assigned(FOnGetHandle) then
+    FOnGetHandle(Self,Result,FCloseHandleOnExecute);
+  if FCustomHandle=THandle(INVALID_HANDLE_VALUE) then
+    Raise EProcess.Create('Cannot get custom handle. No handle set');
+end;
+
+Function TIODescriptor.CreateProcessHandle : THandle;
+
+begin
+  if Not Assigned(Process) then
+    Raise EProcess.Create('Cannot get handle. No process assigned');
+  case ProcessHandleType of
+    phtInput:  Result:=Process.OutputDescriptor.OurHandle;
+    phtOutput:  Result:=Process.InputDescriptor.OurHandle;
+    phtError:  Result:=Process.InputDescriptor.OurHandle;
+  end;
+  if Result=THandle(INVALID_HANDLE_VALUE) then
+    Raise EProcess.Create('Cannot get handle. Process not active');
+end;
+
+function TIODescriptor.ResolveStream: THandleStream;
+begin
+  if (FStream=Nil) and (FHandleValid) and (FTheirHandleIOType=iotPipe) then
+    begin
+    // Writeln(ProcessHandleType,' creating stream for stream ',IOType,': ',OurHandle);
+    Case FHandleType of
+      phtInput : FStream:=TOutputPipeStream.Create(OurHandle);
+      phtError,
+      phtOutput : FStream:=TInputPipeStream.Create(OurHandle);
+    end;
+    end;
+  FOurHandle:=THandle(INVALID_HANDLE_VALUE);
+  Result:=FStream;
+end;
+
+
+procedure TIODescriptor.CloseOurHandle;
+
+var
+  H : THandle;
+
+begin
+  if Not FHandleValid then
+     exit;
+  H:=OurHandle;
+  // Writeln(StdErr, GetProcessID ,' : ',ProcessHandleType,' closing our handle ',IOType,': ',FOurHandle);
+  FOurHandle:=THandle(INVALID_HANDLE_VALUE) ;
+  if H<>THandle(INVALID_HANDLE_VALUE) then
+    FileClose(H);
+end;
+
+procedure TIODescriptor.CloseTheirHandle(aForceClose: Boolean);
+var
+  H : THandle;
+
+begin
+  if Not FHandleValid then
+     exit;
+  If (FTheirHandleIOType=iotNone) or not (CloseHandleOnExecute or aForceClose) then
+    begin
+    FTheirHandle:=THandle(INVALID_HANDLE_VALUE);
+     exit;
+    end;
+  H:=ResolveProcessHandle;
+  // Writeln(StdErr,GetProcessID,' : ',ProcessHandleType,' closing their handle ',IOType,': ',H);
+  FTheirHandle:=THandle(INVALID_HANDLE_VALUE);
+  if H<>THandle(INVALID_HANDLE_VALUE) then
+    begin
+    FileClose(H);
+    end;
+end;
+
+procedure TIODescriptor.PrepareHandles;
+
+var
+  H : THandle;
+  S : String;
+
+begin
+  WriteStr(S,IOType);
+  H:=ResolveProcessHandle;
+  // Writeln('PReparing handle ',S,' : ',H,' (ours: ',OurHandle,')');
+  if H=THandle(INVALID_HANDLE_VALUE) then
+     Raise EProcess.CreateFmt('Failed to prepare process handle for %s',[S]);
+end;
+
+procedure TIODescriptor.ResetHandles;
+
+begin
+  CloseOurHandle;
+  CloseTheirHandle(True);
+  FreeAndNil(FStream);
+  FHandleValid:=False;
+end;
+
+
+
+function TIODescriptor.ResolveProcessHandle: THandle;
+
+var
+  H : THandle;
+
+begin
+  if not FHandleValid then
+    begin
+    FTheirHandleIOType := IOType;
+    FOurHandle:=THAndle(INVALID_HANDLE_VALUE);
+    Case IOType of
+      iotNone : H:=CreateStandardHandle;
+      iotPipe : H:=CreatePipeHandle;
+      iotFile : H:=CreateFileNameHandle;
+      iotProcess : H:=CreateProcessHandle;
+      iotHandle : H:=CreateCustomHandle;
+      iotNull : H:=CreateNullFileHandle;
+    end;
+    FCloseHandleOnExecute:=(IOType<>iotNone);
+    FTheirHandle:=PrepareCreatedHandleForProcess(H);
+    if Assigned(FAfterAllocateHandle) then
+      FAfterAllocateHandle(Self,FTheirHandle,FCloseHandleOnExecute);
+    FHandleValid:=True;
+    end;
+  Result:=FTheirHandle;
+end;
+
+constructor TIODescriptor.Create(aOwnerProcess: TProcess; aType: TProcessHandleType);
+begin
+  FOwnerProcess:=aOwnerProcess;
+  FHandleType:=aType;
+  FCustomHandle:=THandle(INVALID_HANDLE_VALUE);
+  FTheirHandle:=THandle(INVALID_HANDLE_VALUE);
+  FOurHandle:=THandle(INVALID_HANDLE_VALUE);
+  FPipeBufferSize := 1024;
+end;
+
+destructor TIODescriptor.Destroy;
+begin
+  FreeAndNil(FStream);
+  ResetHandles;
+  inherited Destroy;
+end;
+
 end.

+ 2 - 0
packages/fcl-process/src/processunicode.pp

@@ -46,6 +46,8 @@ Type
   TRunCommandEventCode = {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Process.TRunCommandEventCode;
   TOnRunCommandEvent = {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Process.TOnRunCommandEvent;
   EProcess = {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Process.EProcess;
+  
+  TProcess = Class;
 
 {$macro on}
 {$IF SIZEOF(CHAR)=1}

+ 97 - 49
packages/fcl-process/src/unix/process.inc

@@ -1,3 +1,4 @@
+{%main ../process.pp}
 {
     This file is part of the Free Component Library (FCL)
     Copyright (c) 1999-2008 by the Free Pascal development team
@@ -32,7 +33,6 @@ Resourcestring
   SErrNoSuchProgram     = 'Executable not found: "%s"';
   SErrNoTerminalProgram = 'Could not detect X-Terminal program';
   SErrCannotFork        = 'Failed to Fork process';
-  SErrCannotCreatePipes = 'Failed to create pipes';
 
 Const
   // unused as of yet, I assume these are nice levels ?
@@ -43,6 +43,9 @@ Const
   GeometryOption : String = '-geometry';
   TitleOption : String ='-title';
 
+
+
+
 procedure TProcess.CloseProcessHandles;
 
 begin
@@ -58,6 +61,7 @@ begin
     Result:=0;
 end;
 
+
 Function TProcess.PeekExitStatus : Boolean;
 var
   res: cint;
@@ -137,10 +141,19 @@ Function DetectXterm : String;
   end;
 
 Const
+  xterm = 'xterm';
   Konsole   = 'konsole';
   GNomeTerm = 'gnome-terminal';
+  // Windowmaker
+  aterm = 'aterm';
+  wterm = 'wterm';
+  // Xfce
+  xfceterm = 'xfce4-terminal';
+  rxvt = 'rxvt';
+  xtermemulator = 'x-terminal-emulator';
+
   DefaultTerminals : Array [1..6] of string
-                   = ('x-terminal-emulator','xterm','aterm','wterm','rxvt','xfce4-terminal');
+                   = (xtermemulator,xterm,aterm,wterm,rxvt,xfceterm);
 
 Var
   D :String;
@@ -151,25 +164,25 @@ begin
     // try predefined
     If Length(TryTerminals)>0 then
       TestTerminals(TryTerminals);
-    // try session-specific terminal
+    // try session-specific terminal first.
     if (XTermProgram='') then
       begin
       D:=LowerCase(GetEnvironmentVariable('DESKTOP_SESSION'));
       If (Pos('kde',D)<>0) then
         begin
-        TestTerminal('konsole');
+        TestTerminal(konsole);
         end
       else if (D='gnome') then
         begin
-        TestTerminal('gnome-terminal');
+        TestTerminal(gnometerm);
         end
       else if (D='windowmaker') then
         begin
-        If not TestTerminal('aterm') then
-          TestTerminal('wterm');
+        If not TestTerminal(aterm) then
+          TestTerminal(wterm);
         end
       else if (D='xfce') then
-        TestTerminal('xfce4-terminal');
+        TestTerminal(xfceterm);
       end;
     if (XTermProgram='') then
       TestTerminals(DefaultTerminals)
@@ -322,21 +335,19 @@ begin
   until (safefpdup2<>-1) or (fpgeterrno<>ESysEINTR);
 end;
 
-Procedure TProcess.Execute;
+Procedure TProcess.SysExecute;
 
 Var
-  HI,HO,HE : TPipePair;
   PID      : Longint;
   FEnv     : PPAnsiChar;
   Argv     : PPAnsiChar;
-  fd       : Integer;
-  res      : cint;
   FoundName,
   PName    : String;
 
 begin
-  If (poUsePipes in Options) then
-    CreatePipes(HI, HO, HE, Not(poPassInput in Options), Not (poStdErrToOutPut in Options));
+  FDescriptors[phtInput].PrepareHandles;
+  FDescriptors[phtOutput].PrepareHandles;
+  FDescriptors[phtError].PrepareHandles;
   Try
     if FEnvironment.Count<>0 then
       FEnv:=StringsToPcharList(FEnvironment)
@@ -410,30 +421,26 @@ begin
                    fpexit(127);
 {$pop}
                end;
-            if PoUsePipes in Options then
-              begin
-                if not (poPassInput in Options) then
-                  begin
-                    FileClose(HI[peWrite]);
-                    safefpdup2(HI[peRead],0);
-                  end;
-                FileClose(HO[peRead]);
-                safefpdup2(HO[peWrite],1);
-                if (poStdErrToOutPut in Options) then
-                  safefpdup2(HO[peWrite],2)
-                else
-                  begin
-                    FileClose(HE[peRead]);
-                    safefpdup2(HE[peWrite],2);
-                  end
-              end
-            else if poNoConsole in Options then
-              begin
-                fd:=FileOpen('/dev/null',fmOpenReadWrite or fmShareDenyNone);
-                safefpdup2(fd,0);
-                safefpdup2(fd,1);
-                safefpdup2(fd,2);
-              end;
+            if FDescriptors[phtInput].ResolveProcessHandle<>StdInputHandle then
+               begin
+               if FDescriptors[phtInput].IOType=iotPipe then
+                 FDescriptors[phtInput].CloseOurHandle;
+               safefpdup2(FDescriptors[phtInput].ResolveProcessHandle,0);
+               end;
+            if FDescriptors[phtOutput].ResolveProcessHandle<>StdOutputHandle then
+               begin
+               if FDescriptors[phtOutput].IOType=iotPipe then
+                 FDescriptors[phtOutput].CloseOurHandle;
+               safefpdup2(FDescriptors[phtOutput].ResolveProcessHandle,1);
+               if (poStdErrToOutPut in Options) then
+                 safefpdup2(FDescriptors[phtOutput].ResolveProcessHandle,2);
+               end;
+            if not (poStdErrToOutPut in Options) and (FDescriptors[phtError].ResolveProcessHandle<>StdErrorHandle) then
+               begin
+               if FDescriptors[phtOutput].IOType=iotPipe then
+                 FDescriptors[phtError].CloseOurHandle;
+               safefpdup2(FDescriptors[phtError].ResolveProcessHandle,2);
+               end;
             if Assigned(FForkEvent) then
               FForkEvent(Self);
             if (poRunSuspended in Options) then
@@ -452,15 +459,10 @@ begin
         FreePCharList(FEnv);
     end;
   Finally
-    if POUsePipes in Options then
-      begin
-        FileClose(HO[peWrite]);
-        if not (POPassInput in Options) then
-          FileClose(HI[peRead]);
-        if Not (poStdErrToOutPut in FProcessOptions) then
-          FileClose(HE[peWrite]);
-        CreateStreams(HI[peWrite],HO[peRead],HE[peRead]);
-      end;
+    // Writeln(system.StdErr,'fork closing our handles');
+    FDescriptors[phtInput].CloseTheirHandle;
+    FDescriptors[phtOutput].CloseTheirHandle;
+    FDescriptors[phtError].CloseTheirHandle;
   end;
   FRunning:=True;
   if not (csDesigning in ComponentState) and // This would hang the IDE !
@@ -527,6 +529,7 @@ begin
     Result:=1;
 end;
 
+
 Function TProcess.Resume : LongInt;
 
 begin
@@ -539,9 +542,17 @@ end;
 Function TProcess.Terminate(AExitCode : Integer) : Boolean;
 
 begin
+  if aExitCode<>0 then ; // silence compiler warning
   Result:=fpkill(Handle,SIGTERM)=0;
-  If Result and Running then
-    Result:=fpkill(Handle,SIGKILL)=0;
+  If Result then
+    begin
+    // Give the process some time to handle it. Sleeping may also yield to the process.
+    if SignalWaitTime>0 then
+      Sleep(SignalWaitTime);
+    // Not handled yet ?
+    if Running then
+      Result:=fpkill(Handle,SIGKILL)=0;
+    end;
   { the fact that the signal has been sent does not
     mean that the process has already handled the
     signal -> wait instead of calling getexitstatus }
@@ -555,3 +566,40 @@ begin
   FShowWindow:=Value;
 end;
 
+function TIODescriptor.SysPrepareCreatedHandleForProcess(aHandle: THandle): THandle;
+begin
+  Result:=aHandle;
+end;
+
+
+function TIODescriptor.SysCreateFileNameHandle(const aFileName: string): THandle;
+
+const
+  DefaultRights = 438; // 438 = 666 octal which is rw rw rw
+  ModeNames : Array[Boolean] of String = ('Reading','Writing');
+
+begin
+  if (aFileName='') then
+    Raise EProcess.Create('No filename provided');
+  case ProcessHandleType of
+    phtInput:  Result:=FileOpen(aFileName,fmOpenRead);
+    phtOutput,
+    phtError: if FileExists(aFileName) then
+                Result:=FileOpen(aFileName,fmOpenWrite or fmShareDenyNone)
+              else
+                Result:=FileCreate(aFileName,fmShareDenyNone,DefaultRights)
+  end;
+  if (Result=-1) then
+    Raise EProcess.CreateFmt('Could not open file "%s" for %s',[aFileName,ModeNames[ProcessHandleType<>phtInput]]);
+end;
+
+function TIODescriptor.SysNullFileName: string;
+begin
+  result:='/dev/null';
+end;
+
+function TIODescriptor.SysIsTypeSupported(AValue: TIOType): Boolean;
+begin
+  Result:=True;
+end;
+

+ 103 - 91
packages/fcl-process/src/win/process.inc

@@ -32,7 +32,7 @@ Const
                        NORMAL_PRIORITY_CLASS,REALTIME_PRIORITY_CLASS,
                        BELOW_NORMAL_PRIORITY_CLASS,ABOVE_NORMAL_PRIORITY_CLASS);
 
-procedure TProcessnamemacro.CloseProcessHandles;
+procedure TProcess.CloseProcessHandles;
 begin
   if (FProcessHandle<>0) then
     CloseHandle(FProcessHandle);
@@ -40,7 +40,7 @@ begin
     CloseHandle(FThreadHandle);
 end;
 
-Function TProcessnamemacro.PeekExitStatus : Boolean;
+Function TProcess.PeekExitStatus : Boolean;
 begin
   Result:=GetExitCodeProcess(ProcessHandle,FExitCode) and (FExitCode<>Still_Active);
   // wait up to 10ms extra till process really done to get rest of input bug #39821
@@ -48,12 +48,10 @@ begin
     WaitForSingleObject(FProcessHandle,10);
 end;
 
-Function GetStartupFlags (P : TProcessnamemacro): Cardinal;
+Function GetStartupFlags (P : TProcess): Cardinal;
 
 begin
-  Result:=0;
-  if poUsePipes in P.Options then
-     Result:=Result or Startf_UseStdHandles;
+  Result:= Startf_UseStdHandles;
   if suoUseShowWindow in P.StartupOptions then
     Result:=Result or startf_USESHOWWINDOW;
   if suoUSESIZE in P.StartupOptions then
@@ -66,7 +64,7 @@ begin
     Result:=Result or startf_USEFILLATTRIBUTE;
 end;
 
-Function GetCreationFlags(P : TProcessnamemacro) : Cardinal;
+Function GetCreationFlags(P : TProcess) : Cardinal;
 
 begin
   Result:=CREATE_UNICODE_ENVIRONMENT;
@@ -114,21 +112,21 @@ begin
   CopyMemory(Result, @EnvBlock[1], Length(EnvBlock)*2);
 end;
 
-Procedure InitProcessAttributes(P : TProcessnamemacro; Var PA : TSecurityAttributes);
+Procedure InitProcessAttributes(P : TProcess; Var PA : TSecurityAttributes);
 
 begin
   FillChar(PA,SizeOf(PA),0);
   PA.nLength := SizeOf(PA);
 end;
 
-Procedure InitThreadAttributes(P : TProcessnamemacro; Var TA : TSecurityAttributes);
+Procedure InitThreadAttributes(P : TProcess; Var TA : TSecurityAttributes);
 
 begin
   FillChar(TA,SizeOf(TA),0);
   TA.nLength := SizeOf(TA);
 end;
 
-Procedure InitStartupInfo(P : TProcessnamemacro; Var SI : STARTUPINFOW);
+Procedure InitStartupInfo(P : TProcess; Var SI : STARTUPINFOW);
 
 Const
   SWC : Array [TShowWindowOptions] of Cardinal =
@@ -162,67 +160,6 @@ begin
    SI.dwX:=P.WindowLeft;
 end;
 
-{ The handles that are to be passed to the child process must be
-  inheritable. On the other hand, only non-inheritable handles
-  allow the sending of EOF when the write-end is closed. This
-  function is used to duplicate the child process's ends of the
-  handles into inheritable ones, leaving the parent-side handles
-  non-inheritable.
-}
-function DuplicateHandleFP(var handle: THandle): Boolean;
-
-var
-  oldHandle: THandle;
-begin
-  oldHandle := handle;
-  Result := DuplicateHandle
-  ( GetCurrentProcess(),
-    oldHandle,
-    GetCurrentProcess(),
-    @handle,
-    0,
-    true,
-    DUPLICATE_SAME_ACCESS
-  );
-  if Result then
-    Result := CloseHandle(oldHandle);
-end;
-
-
-Procedure CreatePipes(Var HI,HO,HE : Thandle; Var SI : TStartupInfoW; CI, CE : Boolean; APipeBufferSize : Cardinal);
-
-begin
-  if CI then
-    begin
-      CreatePipeHandles(SI.hStdInput,HI, APipeBufferSize);
-      DuplicateHandleFP(SI.hStdInput);
-    end
-  else
-    begin
-      SI.hStdInput:=StdInputHandle;
-    end;
-  CreatePipeHandles(HO,Si.hStdOutput, APipeBufferSize);
-  DuplicateHandleFP(   Si.hStdOutput);
-  if CE then begin
-    CreatePipeHandles(HE,SI.hStdError, APipeBufferSize);
-    DuplicateHandleFP(   SI.hStdError);
-    end
-  else
-    begin
-    SI.hStdError:=SI.hStdOutput;
-    HE:=HO;
-    end;
-end;
-
-{Function MaybeQuote(Const S : String) : String;
-
-begin
-  If (Pos(' ',S)<>0) then
-    Result:='"'+S+'"'
-  else
-     Result:=S;
-end;
-}
 Function MaybeQuoteIfNotQuoted(Const S : TProcessString) : TProcessString;
 
 begin
@@ -233,7 +170,7 @@ begin
 end;
 
 
-Procedure TProcessnamemacro.Execute;
+Procedure TProcess.SysExecute;
 Var
   i : Integer;
   WName,WDir,WCommandLine : UnicodeString;
@@ -248,6 +185,9 @@ Var
   Cmd : TProcessString;
 
  begin
+  FDescriptors[phtInput].PrepareHandles;
+  FDescriptors[phtOutput].PrepareHandles;
+  FDescriptors[phtError].PrepareHandles;
   WName:='';
   WCommandLine:='';
   WDir:='';
@@ -278,8 +218,12 @@ Var
     InitProcessAttributes(Self,FProcessAttributes);
     InitThreadAttributes(Self,FThreadAttributes);
     InitStartupInfo(Self,FStartUpInfo);
-    If poUsePipes in Options then
-      CreatePipes(HI,HO,HE,FStartupInfo,Not(poPassInput in Options), Not(poStdErrToOutPut in Options), FPipeBufferSize);
+    FStartupInfo.hStdInput:=FDescriptors[phtInput].ResolveProcessHandle;
+    FStartupInfo.hStdOutput:=FDescriptors[phtOutput].ResolveProcessHandle;
+    if Not(poStdErrToOutPut in Options) then
+      FStartupInfo.hStdError:=FDescriptors[phtError].ResolveProcessHandle
+    else
+      FStartupInfo.hStdError:=FStartupInfo.hStdOutput;
     Try
       // Beware: CreateProcess can alter the strings
       // Beware: nil is not the same as a pointer to a #0
@@ -295,17 +239,9 @@ Var
       FThreadId:=FProcessInformation.dwThreadId;  
       FProcessID:=FProcessINformation.dwProcessID;
     Finally
-      if POUsePipes in Options then
-        begin
-        if not (poPassInput in Options) then
-          FileClose(FStartupInfo.hStdInput);
-        FileClose(FStartupInfo.hStdOutput);
-        if Not (poStdErrToOutPut in Options) then
-          FileClose(FStartupInfo.hStdError);
-        CreateStreams(HI,HO,HE);
-        if poPassInput in Options then
-           FInputStream.DontClose:=true;
-        end;
+      FDescriptors[phtInput].CloseTheirHandle;
+      FDescriptors[phtOutput].CloseTheirHandle;
+      FDescriptors[phtError].CloseTheirHandle;
     end;
     FRunning:=True;
   Finally
@@ -318,7 +254,7 @@ Var
     WaitOnExit;
 end;
 
-Function TProcessnamemacro.WaitOnExit : Boolean;
+Function TProcess.WaitOnExit : Boolean;
 Var
   R : DWord;
 begin
@@ -329,7 +265,7 @@ begin
   FRunning:=False;
 end;
 
-Function TProcessnamemacro.WaitOnExit(Timeout : DWord) : Boolean;
+Function TProcess.WaitOnExit(Timeout : DWord) : Boolean;
 Var
   R : DWord;
 begin
@@ -342,19 +278,19 @@ begin
     end;
 end;
 
-Function TProcessnamemacro.Suspend : Longint;
+Function TProcess.Suspend : Longint;
 
 begin
   Result:=SuspendThread(ThreadHandle);
 end;
 
-Function TProcessnamemacro.Resume : LongInt;
+Function TProcess.Resume : LongInt;
 
 begin
   Result:=ResumeThread(ThreadHandle);
 end;
 
-Function TProcessnamemacro.Terminate(AExitCode : Integer) : Boolean;
+Function TProcess.Terminate(AExitCode : Integer) : Boolean;
 
 begin
   Result:=False;
@@ -362,8 +298,84 @@ begin
     Result:=TerminateProcess(Handle,AexitCode);
 end;
 
-Procedure TProcessnamemacro.SetShowWindow (Value : TShowWindowOptions);
+Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);
 
 begin
   FShowWindow:=Value;
 end;
+
+Function TIODescriptor.SysCreateFileNameHandle(const aFileName: string) : THandle;
+
+const
+  DefaultRights = 438; // 438 = 666 octal which is rw rw rw
+  ModeNames : Array[Boolean] of String = ('Reading','Writing');
+
+var
+  FM :  Integer;
+  Sec: SECURITY_ATTRIBUTES;
+
+begin
+  if (aFileName='') then
+    Raise EProcess.Create('No filename set');
+  FillByte(sec, SizeOf(sec), 0);
+  sec.nLength := SizeOf(Sec);
+  sec.bInheritHandle := True;
+  case ProcessHandleType of
+    phtInput:  Result:=CreateFileW(PWideChar(WideString(aFileName)), GENERIC_READ,
+      FILE_SHARE_READ, @sec, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
+    phtOutput,
+    phtError:
+      begin
+        Result:=CreateFileW(PWideChar(WideString(aFileName)), GENERIC_WRITE,
+          FILE_SHARE_READ, @sec, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
+        if not(Result=INVALID_HANDLE_VALUE) then
+          FileSeek(Result, 0, 2);
+      end;
+  end;
+  if (Result=INVALID_HANDLE_VALUE) then
+    Raise EProcess.CreateFmt('Could not open file "%s" for %s',[aFileName,ModeNames[ProcessHandleType<>phtInput]]);
+end;
+
+
+
+function TIODescriptor.SysPrepareCreatedHandleForProcess(aHandle: THandle): THandle;
+
+var
+  oldHandle: THandle;
+  Res : Boolean;
+  
+begin
+  if IOType in [iotNone,iotFile] then begin
+    Result:=aHandle;
+    exit;
+  end;
+  oldHandle := ahandle;
+  ahandle:=THandle(INVALID_HANDLE_VALUE); 
+  Res := DuplicateHandle
+  ( GetCurrentProcess(),
+    oldHandle,
+    GetCurrentProcess(),
+    @aHandle,
+    0,
+    true,
+    DUPLICATE_SAME_ACCESS
+  );
+  if Res then
+    Res:=CloseHandle(oldHandle);
+  if not Res then
+    begin
+    FileClose(aHandle);
+    Raise EProcess.CreateFmt('Could not make handle %d inheritable',[aHandle]);
+    end;
+  Result:=aHandle;
+end;    
+
+function TIODescriptor.SysNullFileName: string;
+begin
+  result:='NULL';
+end;
+
+function TIODescriptor.SysIsTypeSupported(AValue: TIOType): Boolean;
+begin
+  Result:=True;
+end;

+ 61 - 0
packages/fcl-process/tests/docat.lpi

@@ -0,0 +1,61 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="docat"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="docat.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="docat"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value=""/>
+      </ConfigFile>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 29 - 0
packages/fcl-process/tests/docat.pp

@@ -0,0 +1,29 @@
+program docat;
+
+Procedure ReadAndWrite(var O : Text);
+
+var
+  S : AnsiString;
+
+begin
+  While not EOF(O) do
+    begin
+    Readln(O,S);
+    Writeln(S);
+    end;
+end;
+
+var
+  F : Text;
+
+begin
+  if ParamStr(1)<>'' then
+    begin
+    Assign(F,ParamStr(1));
+    Reset(F);
+    ReadAndWrite(F);
+    end
+  else
+    ReadAndWrite(INput);
+end.
+

+ 61 - 0
packages/fcl-process/tests/doexit.lpi

@@ -0,0 +1,61 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="doexit"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="doexit.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="doexit"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value=""/>
+      </ConfigFile>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 15 - 0
packages/fcl-process/tests/doexit.pp

@@ -0,0 +1,15 @@
+program doexit;
+
+uses sysutils;
+
+var
+  WT,EC : Integer;
+
+begin
+  EC:=StrToIntDef(ParamStr(1),0);
+  WT:=StrToIntDef(ParamStr(2),0);
+  if WT>0 then
+    Sleep(WT);
+  Halt(EC);
+end.
+

+ 61 - 0
packages/fcl-process/tests/dols.lpi

@@ -0,0 +1,61 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="dols"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="dols.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="dols"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value=""/>
+      </ConfigFile>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 38 - 0
packages/fcl-process/tests/dols.pp

@@ -0,0 +1,38 @@
+program dols;
+
+uses sysutils;
+
+var
+  Idx,Count : integer;
+  Dir : String;
+  Info : TSearchRec;
+  Long : Boolean;
+
+
+begin
+  Dir:=GetCurrentDir;
+  Idx:=1;
+  if ParamStr(Idx)='-l' then
+    begin
+    Inc(Idx);
+    Long:=True;
+    end;
+  if ParamStr(Idx)<>'' then
+    Dir:=ParamStr(Idx);
+  Dir:=IncludeTrailingPathDelimiter(Dir);
+  Count:=0;
+  If FindFirst(Dir+AllFilesMask,faAnyFile,Info)=0 then
+    try
+      Repeat
+        if Long then
+          Write(Info.Size:14,' ',DateTimeToStr(Info.TimeStamp));
+        Writeln(Info.Name);
+        Inc(Count);
+      Until FindNext(Info)<>0;
+
+    finally
+      FindClose(Info);
+    end;
+  Writeln('Total: ',Count);
+end.
+

+ 61 - 0
packages/fcl-process/tests/dotouch.lpi

@@ -0,0 +1,61 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="dotouch"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="dotouch.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="dotouch"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value=""/>
+      </ConfigFile>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 17 - 0
packages/fcl-process/tests/dotouch.pp

@@ -0,0 +1,17 @@
+program dotouch;
+
+
+var
+  F : Text;
+  N : String;
+
+begin
+  N:=ParamStr(1);
+  if N='' then
+    N:='touch.txt';
+  Assign(F,N);
+  Rewrite(F);
+  Writeln(F,N);
+  Close(F);
+end.
+

+ 61 - 0
packages/fcl-process/tests/genout.lpi

@@ -0,0 +1,61 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="genout"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="genout.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="genout"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value=""/>
+      </ConfigFile>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 24 - 0
packages/fcl-process/tests/genout.pp

@@ -0,0 +1,24 @@
+program genout;
+
+uses sysutils;
+
+var
+  I,aOffset, aCount : Integer;
+  UseStdErr : Boolean;
+
+begin
+  // number of lines to emit. If negative, use stderr
+  aCount:=StrToIntDef(ParamStr(1),3);
+  // Offset : start at 1+Offset
+  aOffset:=StrToIntDef(ParamStr(2),0);
+  UseStdErr:=aCount<0;
+  aCount:=Abs(aCount);
+  aCount:=aCount+aOffset;
+  Inc(aOffset);
+  For I:=aOffset to aCount do
+    if UseStdErr then
+      Writeln(StdErr,'Line ',IntToStr(I))
+    else
+      Writeln('Line ',IntToStr(I));
+end.
+

+ 76 - 0
packages/fcl-process/tests/testprocess.lpi

@@ -0,0 +1,76 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testprocess"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="FCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="testprocess.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcprocess.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testprocess"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir);../src/unix"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value=""/>
+      </ConfigFile>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 28 - 0
packages/fcl-process/tests/testprocess.pp

@@ -0,0 +1,28 @@
+program testprocess;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, utcprocess;
+
+type
+
+  { TMyTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+  // override the protected methods of TTestRunner to customize its behavior
+  end;
+
+var
+  Application: TMyTestRunner;
+
+begin
+  DefaultRunAllTests:=True;
+  DefaultFormat:=fPlain;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'FPCUnit Console test runner';
+  Application.Run;
+  Application.Free;
+end.

+ 594 - 0
packages/fcl-process/tests/utcprocess.pp

@@ -0,0 +1,594 @@
+unit utcprocess;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, pipes, process;
+
+type
+
+  { TTestProcess }
+
+  TTestProcess= class(TTestCase)
+  private
+    FProc: TProcess;
+    FProc2: TProcess;
+    FProc3: TProcess;
+    procedure AssertFileContent(const aFileName, aContent: String);
+    procedure AssertFileContent(const aFileName: String; aContent: array of string);
+    procedure AssertGenOutLines(const S: String; aCount: integer);
+    procedure AssertGenOutLinesFile(const aFileName : string; aCount : Integer);
+    procedure CreateInputLinesFile(const aFileName : string; aCount : Integer);
+    function GetHelper(const aHelper: string): String;
+    function GetTestFile(const aName: string): String;
+    function ReadProcessOutput(aProc: TProcess; ReadStdErr : Boolean = False): string;
+    procedure WaitForFile(const aFileName: String);
+  protected
+    procedure CheckHelper(const aHelper : string);
+    procedure SetUp; override;
+    procedure TearDown; override;
+    property Proc : TProcess read FProc;
+    property Proc2 : TProcess read FProc2;
+    property Proc3 : TProcess read FProc3;
+  published
+    procedure TestHookUp;
+    procedure TestSimple;
+    procedure TestSimpleParam;
+    Procedure TestExitStatus;
+    Procedure TestWaitFor;
+    Procedure TestOptionWaitOnExit;
+    Procedure TestTerminate;
+    Procedure TestPipes;
+    Procedure TestWritePipes;
+    Procedure TestStdErr;
+    Procedure TestStdErrToOutput;
+    Procedure TestInputFile;
+    Procedure TestOutputFile;
+    Procedure TestStdErrFile;
+    Procedure TestInputNull;
+    Procedure TestOutputFileExistingAppend;
+    Procedure TestOutputFileExistingTruncate;
+    Procedure TestOutputFileExistingAtStart;
+    Procedure TestPipeOut;
+    Procedure TestPipeOutToFile;
+    Procedure TestPipeInOutToFile;
+    Procedure TestPipeRestart;
+  end;
+
+implementation
+
+uses dateutils;
+
+const
+  dotouch = 'dotouch';
+  docat = 'docat';
+  doexit = 'doexit';
+  genout = 'genout';
+  fntouch = 'touch.txt';
+  fntestoutput = 'output.txt';
+  fntestinput = 'input.txt';
+
+var
+  TestDir : String;
+  TmpDir : String;
+
+procedure TTestProcess.AssertFileContent(const aFileName,aContent : String);
+begin
+  AssertFileContent(aFileName,[aContent]);
+end;
+
+procedure TTestProcess.AssertFileContent(const aFileName : String; aContent : Array of string);
+
+var
+  L : TStrings;
+  I : integer;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.LoadFromFile(aFileName);
+    AssertEquals('Line count',Length(aContent),L.Count);
+    for I:=0 to L.Count-1 do
+      AssertEquals('Line '+Inttostr(i)+'content',aContent[I],L[i]);
+  finally
+    L.Free;
+  end;
+
+end;
+
+Procedure TTestProcess.WaitForFile(const aFileName : String);
+
+var
+  aCount : Integer;
+  FN : String;
+  Exists : boolean;
+
+begin
+  FN:=aFileName;
+  aCount:=0;
+  Repeat
+    Sleep(20);
+    Inc(aCount);
+    Exists:=FileExists(FN);
+  Until (aCount>=50) or Exists;
+  AssertTrue('File did not appear: '+FN,Exists);
+  Sleep(20);
+end;
+
+procedure TTestProcess.TestHookUp;
+
+  procedure AssertNoFile(const FN :string);
+  begin
+    AssertFalse('File '+FN+' does not exist',FileExists(FN));
+  end;
+
+begin
+  AssertNotNull('Have process 1',Proc);
+  AssertNotNull('Have process 2',Proc2);
+  AssertNotNull('Have process 3',Proc3);
+  AssertNoFile(fntouch);
+  AssertNoFile(GetTestFile(fnTouch));
+  AssertNoFile(GetTestFile(fntestoutput));
+end;
+
+procedure TTestProcess.TestSimple;
+
+begin
+  Proc.Executable:=GetHelper(dotouch);
+  Proc.Execute;
+  AssertNull('no input stream',Proc.Input);
+  AssertNull('no output stream',Proc.Output);
+  AssertNull('no error stream',Proc.Stderr);
+  WaitForFile(fntouch);
+  AssertFileContent(fntouch,fntouch);
+end;
+
+procedure TTestProcess.TestSimpleParam;
+
+var
+  FN : String;
+begin
+  FN:=GetTestFile(fntouch);
+  Proc.Executable:=GetHelper(dotouch);
+  Proc.Parameters.Add(FN);
+  Proc.Execute;
+  WaitForFile(FN);
+  AssertFileContent(FN,FN);
+end;
+
+procedure TTestProcess.TestExitStatus;
+// Test that halt(23) results in 23...
+begin
+  Proc.Executable:=GetHelper(doexit);
+  Proc.Parameters.Add('23');
+  Proc.Execute;
+  Proc.WaitOnExit;
+  AssertEquals('Exit code',23,Proc.ExitStatus);
+end;
+
+procedure TTestProcess.TestWaitFor;
+
+var
+  N : TDateTime;
+  ms : Int64;
+
+begin
+  Proc.Executable:=GetHelper(doexit);
+  Proc.Parameters.Add('0');
+  Proc.Parameters.Add('1000');
+  N:=Now;
+  Proc.Execute;
+  Proc.WaitOnExit;
+  ms:=MilliSecondsBetween(Now,N);
+  AssertEquals('Exit code',0,Proc.ExitStatus);
+  AssertTrue('Wait time',ms>900);
+
+end;
+
+procedure TTestProcess.TestOptionWaitOnExit;
+var
+  N : TDateTime;
+  ms : Int64;
+
+begin
+  Proc.Executable:=GetHelper(doexit);
+  Proc.Parameters.Add('0');
+  Proc.Parameters.Add('1000');
+  N:=Now;
+  Proc.Options:=Proc.Options+[poWaitOnExit];
+  Proc.Execute;
+  ms:=MilliSecondsBetween(Now,N);
+  AssertEquals('Exit code',0,Proc.ExitStatus);
+  AssertTrue('Wait time',ms>900);
+end;
+
+procedure TTestProcess.TestTerminate;
+
+var
+  N : TDateTime;
+  ms : Int64;
+
+begin
+  Proc.Executable:=GetHelper(doexit);
+  Proc.Parameters.Add('0');
+  Proc.Parameters.Add('2000');
+  N:=Now;
+  Proc.Execute;
+  Sleep(500);
+  Proc.Terminate(23);
+  ms:=MilliSecondsBetween(Now,N);
+  AssertTrue('Process exits at once',ms<1000);
+{$IFDEF UNIX}
+  // Also check Kill if term will not work
+  AssertTrue('Exit status',(15=Proc.ExitStatus) or (9=Proc.ExitStatus));
+{$ENDIF}
+{$IFDEF WINDOWS}
+  // Check exit status provided to terminate.
+  AssertTrue('Exit status',(23=Proc.ExitCode));
+{$ENDIF}
+end;
+
+procedure TTestProcess.AssertGenOutLines(const S : String; aCount : integer);
+
+var
+  L : TStrings;
+  I : Integer;
+
+begin
+  sleep(100);
+//  Writeln('Testing >>',S,'<<');
+  L:=TStringList.Create;
+  try
+    L.Text:=S;
+    AssertEquals('Count',aCount,L.Count);
+    For I:=1 to aCount do
+      AssertEquals('Content Line '+IntToStr(I),'Line '+IntToStr(I),L[I-1]);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestProcess.AssertGenOutLinesFile(const aFileName: string; aCount: Integer);
+var
+  L : TStrings;
+  I : Integer;
+
+begin
+  sleep(100);
+  // Writeln('Testing file >>',aFileName,'<<');
+  L:=TStringList.Create;
+  try
+    L.LoadFromFile(aFileName);
+    AssertEquals('Count',aCount,L.Count);
+    For I:=1 to aCount do
+      AssertEquals('Content Line '+IntToStr(I),'Line '+IntToStr(I),L[I-1]);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestProcess.CreateInputLinesFile(const aFileName: string; aCount: Integer);
+var
+  L : TStrings;
+  I : Integer;
+
+begin
+  // Writeln('Creating Test file >>',aFileName,'<<');
+  L:=TStringList.Create;
+  try
+    For I:=1 to aCount do
+      L.Add('Line '+IntToStr(I));
+    L.SaveToFile(aFileName);
+  finally
+    L.Free;
+  end;
+end;
+
+function TTestProcess.ReadProcessOutput(aProc: TProcess; ReadStdErr: Boolean): string;
+
+var
+  aRead,aLen: Integer;
+  S : String;
+  St : TInputPipeStream;
+begin
+  aRead:=0;
+  aLen:=0;
+  S:='';
+  Sleep(100);
+  if ReadStdErr then
+    st:=aProc.StdErr
+  else
+    st:=aProc.Output;
+  AssertNotNull('Have stream to read output from',St);
+  AssertTrue('Read input',aProc.ReadInputStream(St,aRead,aLen,S,100));
+  SetLength(S,aRead);
+//  Writeln('>>>',S,'<<<');
+  Result:=S;
+end;
+
+procedure TTestProcess.TestPipes;
+
+var
+  S : String;
+
+begin
+  Proc.Executable:=GetHelper(genout);
+  Proc.Options:=[poUsePipes];
+  Proc.Execute;
+  AssertNotNull('input stream',Proc.Input);
+  AssertNotNull('output stream',Proc.Output);
+  AssertNotNull('error stream',Proc.Stderr);
+  S:=ReadProcessOutput(Proc);
+  AssertGenOutLines(S,3);
+end;
+
+procedure TTestProcess.TestWritePipes;
+var
+  Sin,Sout : String;
+
+begin
+  Proc.Executable:=GetHelper(docat);
+  Proc.Options:=[poUsePipes];
+  Proc.Execute;
+  // Note: this test will only work for small amounts of data, less than pipe buffer size.
+  Sin:='this is some text'+sLineBreak+'And some more text'+sLineBreak;
+  Proc.Input.Write(Sin[1],Length(Sin));
+  Proc.CloseInput;
+  SOut:=ReadProcessOutput(Proc);
+  AssertEquals('Out equals in',SIn,Sout);
+end;
+
+procedure TTestProcess.TestStdErr;
+var
+  S : String;
+
+begin
+  Proc.Executable:=GetHelper(genout);
+  Proc.Parameters.Add('-3');
+  Proc.Options:=[poUsePipes];
+  Proc.Execute;
+  S:=ReadProcessOutput(Proc,true);
+  AssertGenOutLines(S,3);
+end;
+
+procedure TTestProcess.TestStdErrToOutput;
+var
+  S : String;
+
+begin
+  Proc.Executable:=GetHelper(genout);
+  Proc.Parameters.Add('-3');
+  Proc.Options:=[poUsePipes,poStderrToOutPut];
+  Proc.Execute;
+  S:=ReadProcessOutput(Proc);
+  AssertGenOutLines(S,3);
+end;
+
+procedure TTestProcess.TestInputFile;
+
+var
+  S : String;
+
+begin
+  CreateInputLinesFile(GetTestFile(fntestinput),3);
+  Proc.Executable:=GetHelper(docat);
+  Proc.InputDescriptor.FileName:=GetTestFile(fntestinput);
+  AssertTrue('Descriptor IOType', Proc.InputDescriptor.IOType=iotFile);
+  Proc.OutputDescriptor.IOType:=iotPipe;
+  Proc.Execute;
+  AssertNull('input stream',Proc.Input);
+  AssertNotNull('output stream',Proc.Output);
+  AssertNull('error stream',Proc.Stderr);
+  S:=ReadProcessOutput(Proc);
+  AssertGenOutLines(S,3);
+end;
+
+procedure TTestProcess.TestOutputFile;
+
+begin
+  Proc.Executable:=GetHelper(genout);
+  Proc.OutputDescriptor.FileName:=GetTestFile(fntestoutput);
+  Proc.Execute;
+  AssertGenOutLinesFile(GetTestFile(fntestoutput),3);
+end;
+
+procedure TTestProcess.TestStdErrFile;
+begin
+  Proc.Executable:=GetHelper(genout);
+  Proc.Parameters.Add('-3');
+  Proc.ErrorDescriptor.FileName:=GetTestFile(fntestoutput);
+  Proc.Execute;
+  AssertGenOutLinesFile(GetTestFile(fntestoutput),3);
+end;
+
+procedure TTestProcess.TestInputNull;
+
+var
+  B : TBytes;
+
+begin
+  Proc.Executable:=GetHelper(docat);
+  Proc.InputDescriptor.IOType:=iotNull;
+  Proc.OutputDescriptor.FileName:=GetTestFile(fntestoutput);
+  Proc.Execute;
+  Sleep(100);
+  B:=Sysutils.GetFileContents(GetTestFile(fntestoutput));
+  AssertEquals('Empty file',0,Length(B));
+end;
+
+procedure TTestProcess.TestOutputFileExistingAppend;
+// Check that we actually append
+begin
+  CreateInputLinesFile(GetTestFile(fntestoutput),3);
+  Proc.Executable:=GetHelper(genout);
+  Proc.Parameters.add('3');
+  Proc.Parameters.add('3');
+  Proc.OutputDescriptor.FileName:=GetTestFile(fntestoutput);
+  Proc.OutputDescriptor.FileWriteMode:=fwmAppend;
+  Proc.Execute;
+  AssertGenOutLinesFile(GetTestFile(fntestoutput),6);
+
+end;
+
+procedure TTestProcess.TestOutputFileExistingTruncate;
+// Check that we actually rewrite
+begin
+  CreateInputLinesFile(GetTestFile(fntestoutput),6);
+  AssertGenOutLinesFile(GetTestFile(fntestoutput),6);
+  Proc.Executable:=GetHelper(genout);
+  Proc.OutputDescriptor.FileName:=GetTestFile(fntestoutput);
+  Proc.OutputDescriptor.FileWriteMode:=fwmTruncate;
+  Proc.Execute;
+  AssertGenOutLinesFile(GetTestFile(fntestoutput),3);
+end;
+
+procedure TTestProcess.TestOutputFileExistingAtStart;
+// Check that we actually write at start of file...
+// Write file with 6 lines (1-6), overwrite files with first 3 lines 7-9
+// Result has 7 - 8 - 9 - 4 - 5 -6
+
+var
+  L : TStrings;
+  I : Integer;
+begin
+  CreateInputLinesFile(GetTestFile(fntestoutput),6);
+  Proc.Executable:=GetHelper(genout);
+  Proc.Parameters.add('3');
+  Proc.Parameters.add('6'); // Offset 6, so first output line is 7
+  Proc.OutputDescriptor.FileName:=GetTestFile(fntestoutput);
+  Proc.OutputDescriptor.FileWriteMode:=fwmAtStart;
+  Proc.Execute;
+  sleep(100);
+  // Writeln('Testing file >>',aFileName,'<<');
+  L:=TStringList.Create;
+  try
+    L.LoadFromFile(GetTestFile(fntestoutput));
+    AssertEquals('Count',6,L.Count);
+    For I:=1 to 3 do
+      AssertEquals('Content Line '+IntToStr(I),'Line '+IntToStr(I+6),L[I-1]);
+    For I:=4 to 6 do
+      AssertEquals('Content Line '+IntToStr(I),'Line '+IntToStr(I),L[I-1]);
+  finally
+    L.Free;
+  end;
+
+end;
+
+procedure TTestProcess.TestPipeOut;
+{ Simulate
+  genout | docat
+  we read output of docat.
+}
+var
+  S : String;
+
+begin
+  Proc.Executable:=GetHelper(genout);
+  Proc2.Executable:=GetHelper(docat);
+  Proc2.OutputDescriptor.IOType:=iotPipe;
+  Proc.OutputDescriptor.Process:=Proc2;
+  AssertTrue('Proc2 input is pipe',Proc2.InputDescriptor.IOType=iotPipe);
+  Proc2.Execute;
+  Proc.execute;
+  S:=ReadProcessOutput(Proc2);
+  AssertGenOutLines(S,3);
+end;
+
+procedure TTestProcess.TestPipeOutToFile;
+
+{ Simulate
+  genout | docat > file
+  we read output from file
+}
+var
+  S : String;
+
+begin
+  Proc.Executable:=GetHelper(genout);
+  Proc2.Executable:=GetHelper(docat);
+  Proc2.OutputDescriptor.FileName:=GetTestFile(fntestoutput);
+  Proc.OutputDescriptor.Process:=Proc2;
+  AssertTrue('Proc2 input is pipe',Proc2.InputDescriptor.IOType=iotPipe);
+  Proc2.Execute;
+  Proc.execute;
+  AssertGenOutLinesFile(GetTestFile(fntestoutput),3);
+end;
+
+procedure TTestProcess.TestPipeInOutToFile;
+{ Simulate
+  docat <input | docat > file
+  we read output from file
+}
+var
+  S : String;
+
+begin
+  CreateInputLinesFile(GetTestFile(fntestinput),3);
+  Proc.Executable:=GetHelper(docat);
+  Proc.InputDescriptor.FileName:=GetTestFile(fntestinput);
+  Proc2.Executable:=GetHelper(docat);
+  Proc2.OutputDescriptor.FileName:=GetTestFile(fntestoutput);
+  Proc.OutputDescriptor.Process:=Proc2;
+  AssertTrue('Proc2 input is pipe',Proc2.InputDescriptor.IOType=iotPipe);
+  Proc2.Execute;
+  Proc.execute;
+  AssertGenOutLinesFile(GetTestFile(fntestoutput),3);
+end;
+
+procedure TTestProcess.TestPipeRestart;
+begin
+
+end;
+
+function TTestProcess.GetTestFile(const aName: string) : String;
+
+begin
+  if TmpDir='' then
+    TmpDir:=GetTempDir(False);
+  Result:=IncludeTrailingPathDelimiter(TmpDir)+aName;
+end;
+
+function TTestProcess.GetHelper(const aHelper: string) : String;
+begin
+  if TestDir='' then
+    TestDir:=ExtractFilePath(ParamStr(0));
+  Result:=IncludeTrailingPathDelimiter(TestDir)+aHelper;
+  {$IFDEF WINDOWS}
+  Result:=Result+'.exe';
+  {$ENDIF}
+end;
+
+procedure TTestProcess.CheckHelper(const aHelper: string);
+var
+  F : String;
+begin
+  F:=GetHelper(aHelper);
+  AssertTrue('No helper '+F+' please compile '+aHelper+'.pp',FileExists(F));
+end;
+
+procedure TTestProcess.SetUp;
+begin
+  FProc:=TProcess.Create(Nil);
+  FProc2:=TProcess.Create(Nil);
+  FProc3:=TProcess.Create(Nil);
+  // CheckHelper(dols);
+  CheckHelper(genout);
+  CheckHelper(docat);
+  CheckHelper(dotouch);
+  CheckHelper(doexit);
+  DeleteFile(fntouch);
+  DeleteFile(GetTestFile(fntouch));
+  DeleteFile(GetTestFile(fntestoutput));
+end;
+
+procedure TTestProcess.TearDown;
+begin
+  FreeAndNil(FProc);
+end;
+
+initialization
+  RegisterTest(TTestProcess);
+end.
+

+ 3 - 1
packages/pastojs/src/pas2jscompiler.pp

@@ -4614,8 +4614,10 @@ begin
   AddDefine('STR_CONCAT_PROCS');
   AddDefine('UNICODE');
   if SubTarget<>'' then
+    begin
     AddDefine('FPC_SUBTARGET',SubTarget);
-
+    AddDefine('FPC_SUBTARGET_'+Uppercase(SubTarget));
+    end;
   FHasShownLogo:=false;
   FHasShownEncoding:=false;
   FFS.Reset;