* Add more checks/tests, add iotNull

packages/fcl-process/src/process.pp

@@ -60,7 +60,7 @@ Type
   TProcessForkEvent = procedure(Sender : TObject) of object;
   {$endif UNIX}
 
-  TIOType = (iotNone, iotPipe, iotFile, iotHandle, iotProcess);
+  TIOType = (iotNone, iotPipe, iotFile, iotHandle, iotProcess, iotNull);
   TProcessHandleType = (phtInput,phtOutput,phtError);
 
   TGetHandleEvent = procedure(Sender : TObject; var aHandle : THandle) of object;

packages/fcl-process/src/processbody.inc

@@ -62,7 +62,9 @@ Type
      procedure SetIOType(AValue: TIOType);
      procedure SetProcess(AValue: TProcess);
      function SysPrepareCreatedHandleForProcess(aHandle: THandle): THandle;
-     Function SysCreateFileNameHandle : THandle;
+     Function SysCreateFileNameHandle(const aFileName : string) : THandle;
+     function SysNullFileName : string;
+     function SysIsTypeSupported(AValue: TIOType) : Boolean;
    protected
      Procedure CheckNotRunning; virtual;
      // Create handles for new process
@@ -70,6 +72,7 @@ Type
      Function CreateStandardHandle : THandle;
      Function CreatePipeHandle : THandle;
      Function CreateFileNameHandle : THandle;
+     Function CreateNullFileHandle : THandle;
      Function CreateCustomHandle : THandle;
      Function CreateProcessHandle : THandle;
      Function ResolveProcessHandle : THandle;
@@ -236,6 +239,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}
 
@@ -888,14 +892,24 @@ begin
 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:=''
+    FFileName:='';
 end;
 
 procedure TIODescriptor.SetProcess(AValue: TProcess);
@@ -969,7 +983,7 @@ end;
 Function TIODescriptor.CreateFileNameHandle : THandle;
 
 begin
-  Result:=SysCreateFileNameHandle;
+  Result:=SysCreateFileNameHandle(FileName);
   if (ProcessHandleType<>phtInput) then
     case FFileWriteMode of
       fwmAtstart: ;
@@ -978,6 +992,11 @@ begin
     end;
 end;
 
+function TIODescriptor.CreateNullFileHandle: THandle;
+begin
+  Result:=SysCreateFileNameHandle(SysNullFileName);
+end;
+
 Function TIODescriptor.CreateCustomHandle : THandle;
 
 begin
@@ -1085,6 +1104,7 @@ begin
       iotFile : H:=CreateFileNameHandle;
       iotProcess : H:=CreateProcessHandle;
       iotHandle : H:=CreateCustomHandle;
+      iotNull : H:=CreateNullFileHandle;
     end;
     FTheirHandle:=PrepareCreatedHandleForProcess(H);
     FHandleValid:=True;

packages/fcl-process/src/unix/process.inc

@@ -544,8 +544,15 @@ 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 }
@@ -565,24 +572,34 @@ begin
 end;
 
 
-Function TIODescriptor.SysCreateFileNameHandle : THandle;
+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 (FileName='') then
-    Raise EProcess.Create('No filename set');
+  if (aFileName='') then
+    Raise EProcess.Create('No filename provided');
   case ProcessHandleType of
-    phtInput:  Result:=FileOpen(FileName,fmOpenRead);
+    phtInput:  Result:=FileOpen(aFileName,fmOpenRead);
     phtOutput,
-    phtError: if FileExists(FileName) then
-                Result:=FileOpen(FileName,fmOpenWrite or fmShareDenyNone)
+    phtError: if FileExists(aFileName) then
+                Result:=FileOpen(aFileName,fmOpenWrite or fmShareDenyNone)
               else
-                Result:=FileCreate(FileName,fmShareDenyNone,DefaultRights)
+                Result:=FileCreate(aFileName,fmShareDenyNone,DefaultRights)
   end;
   if (Result=-1) then
-    Raise EProcess.CreateFmt('Could not open file "%s" for %s',[FileName,ModeNames[ProcessHandleType<>phtInput]]);
+    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;
 

packages/fcl-process/src/win/process.inc

@@ -365,7 +365,7 @@ begin
   FShowWindow:=Value;
 end;
 
-Function TIODescriptor.SysCreateFileNameHandle : THandle;
+Function TIODescriptor.SysCreateFileNameHandle(const aFileName: string) : THandle;
 
 const
   DefaultRights = 438; // 438 = 666 octal which is rw rw rw
@@ -376,25 +376,25 @@ var
   Sec: SECURITY_ATTRIBUTES;
 
 begin
-  if (FileName='') then
+  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(FileName)), GENERIC_READ,
+    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(FileName)), GENERIC_WRITE,
+        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',[FileName,ModeNames[ProcessHandleType<>phtInput]]);
+    Raise EProcess.CreateFmt('Could not open file "%s" for %s',[aFileName,ModeNames[ProcessHandleType<>phtInput]]);
 end;
 
 
@@ -405,3 +405,13 @@ begin
     Raise EProcess.CreateFmt('Could not duplicate handle %d',[aHandle]);
   Result:=aHandle;
 end;    
+
+function TIODescriptor.SysNullFileName: string;
+begin
+  result:='NULL';
+end;
+
+function TIODescriptor.SysIsTypeSupported(AValue: TIOType): Boolean;
+begin
+  Result:=True;
+end;

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>

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.
+

packages/fcl-process/tests/utcprocess.pp

@@ -36,6 +36,10 @@ type
     procedure TestHookUp;
     procedure TestSimple;
     procedure TestSimpleParam;
+    Procedure TestExitStatus;
+    Procedure TestWaitFor;
+    Procedure TestOptionWaitOnExit;
+    Procedure TestTerminate;
     Procedure TestPipes;
     Procedure TestWritePipes;
     Procedure TestStdErr;
@@ -43,17 +47,24 @@ type
     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';
-  dols = 'dols';
+  doexit = 'doexit';
   genout = 'genout';
   fntouch = 'touch.txt';
   fntestoutput = 'output.txt';
@@ -147,6 +158,78 @@ begin
   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
@@ -320,6 +403,79 @@ begin
   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
@@ -381,6 +537,11 @@ begin
   AssertGenOutLinesFile(GetTestFile(fntestoutput),3);
 end;
 
+procedure TTestProcess.TestPipeRestart;
+begin
+
+end;
+
 function TTestProcess.GetTestFile(const aName: string) : String;
 
 begin
@@ -416,6 +577,7 @@ begin
   CheckHelper(genout);
   CheckHelper(docat);
   CheckHelper(dotouch);
+  CheckHelper(doexit);
   DeleteFile(fntouch);
   DeleteFile(GetTestFile(fntouch));
   DeleteFile(GetTestFile(fntestoutput));