Spawning subprocesses with GNAT

Spawning subprocesses with GNAT

[Condic, Marin D.]

O.K. So a little bit of toying around with GNAT (3.10p) on a PC has proven
that it has a better (read "working") method of spawning a child process
than the Win32ada interface seems to have. (The function CreateProcess is
available, but no matter how I juggle around parameters, it seems to not
want to work.)

The package: GNAT.OS_Lib has a routine called: function Non_Blocking_Spawn
which successfully gets a child process running. This has advantages for me
in that I have to support my tool on both a Sun and a PC and with the GNAT
supplied package there is at least a reasonable chance that the interface
will be the same for both the PC and the SUN. The down side is this: I would
really like my sub-process to fire up a new window so that if it writes any
data out, it will not be interleaved with the output of the parent process.
I would also like a means of communicating with this sub-process. It is not
clear how to do this from the GNAT.OS_Lib package spec alone. (Unless you
can use the various file subprograms to set up a pipeline between the two?
Any chance that this would be semi-portable?)

Has anybody had any experience playing around with these operations which
might be useful?

MDC

Marin D. Condic
Real Time & Embedded Systems
United Technologies, Pratt & Whitney
Government Engines & Space Propulsion
M/S 731-95, P.O.B. 109600, West Palm Beach, FL, 33410-9600
Ph: 561.796.8997         Fx: 561.796.4669

"Today is the first day of the rest of your solitary, poor, nasty brutish,
and short existence on this planet"
       -- "Life In Hell"

Re: Spawning subprocesses with GNAT

[Jerry van Dijk]

Condic, Marin D. (condicma@PWFL.COM) wrote:

: O.K. So a little bit of toying around with GNAT (3.10p) on a PC has proven
: that it has a better (read "working") method of spawning a child process
: than the Win32ada interface seems to have. (The function CreateProcess is
: available, but no matter how I juggle around parameters, it seems to not
: want to work.)

Well, the following works for me:

----- server_03.adb ---------------------------------------------------
with Ada.Text_IO;

procedure Server_03 is
begin
   Ada.Text_IO.Put_Line ("Server_03 says 'hello!'");
   delay 3.0;
end Server_03;

----- client_03.adb ---------------------------------------------------
-- example of executing another console process asynchronously (Win32)
-- the program 'server_03.exe' must exist in the same directory

pragma C_Pass_By_Copy (128);

with System;
with Ada.Text_IO;
with Win32.Winnt;
with Win32.Winbase;
with Interfaces.C.Strings;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;

procedure Client_03 is

   use type Win32.BOOL;
   use type Interfaces.C.Unsigned_Long;

   -- convert a C chars_ptr into a Win32 LPCSTR
   function TO_LPCSTR is new Ada.Unchecked_Conversion
     (Interfaces.C.Strings.Chars_Ptr, Win32.LPCSTR);

   -- convert a C chars_ptr into a Win32 LPSTR
   function TO_LPSTR is new Ada.Unchecked_Conversion
     (Interfaces.C.Strings.Chars_Ptr, Win32.LPSTR);

   -- convert a Win32 LPSTR into a C chars_ptr
   function TO_Chars_Ptr is new Ada.Unchecked_Conversion
     (Win32.LPSTR, Interfaces.C.Strings.Chars_Ptr);

   -- convert an Ada String into a Win32 LPCSTR
   function To_LPCSTR (S : String) return Win32.LPCSTR is
   begin
      return TO_LPCSTR (Interfaces.C.Strings.New_String (S));
   end To_LPCSTR;

   -- convert an Ada String into a Win32 LPSTR
   function To_LPSTR (S : String) return Win32.LPSTR is
   begin
      return To_LPSTR (Interfaces.C.Strings.New_String (S));
   end To_LPSTR;

   -- free a Win32 LPCSTR
   procedure Free (S : in out Win32.LPCSTR) is
      function To_Chars_Ptr is new Ada.Unchecked_Conversion
        (Win32.LPCSTR, Interfaces.C.Strings.Chars_Ptr);
      C_String : Interfaces.C.Strings.Chars_Ptr := To_Chars_Ptr (S);
   begin
      Interfaces.C.Strings.Free (C_String);
      S := To_LPCSTR (C_String);
   end Free;

   -- free a Win32 LPSTR
   procedure Free (S : in out Win32.LPSTR) is
      function To_Chars_Ptr is new Ada.Unchecked_Conversion
        (Win32.LPSTR, Interfaces.C.Strings.Chars_Ptr);
      C_String : Interfaces.C.Strings.Chars_Ptr := To_Chars_Ptr (S);
   begin
      Interfaces.C.Strings.Free (C_String);
      S := To_LPSTR (C_String);
   end Free;

   -- free a STARTUPINFOA record
   procedure Free is new Ada.Unchecked_Deallocation
     (Win32.Winbase.STARTUPINFOA, Win32.Winbase.LPSTARTUPINFOA);

   -- free a process information record
   procedure Free is new Ada.Unchecked_Deallocation
     (Win32.Winbase.PROCESS_INFORMATION, Win32.Winbase.LPPROCESS_INFORMATION);

   -- buffer string
   Buffer_Size   : constant := 128;
   Buffer_String : constant String (1 .. Buffer_Size) := (others => ' ');
   Buffer        : Win32.LPSTR := To_LPSTR (Buffer_String);

   -- new console startup parameters
   Our_Startup : constant Win32.Winbase.STARTUPINFOA := (
     Cb              => Win32.Winbase.STARTUPINFOA'Size / 8,
     LpReserved      => null,
     LpDesktop       => null,
     LpTitle         => null,
     DwX             => 0,
     DwY             => 0,
     DwXSize         => 0,
     DwYSize         => 0,
     DwXCountChars   => 0,
     DwYCountChars   => 0,
     DwFillAttribute => 0,
     DwFlags         => 0,
     WShowWindow     => 0,
     CbReserved2     => 0,
     LpReserved2     => null,
     HStdInput       => System.Null_Address,
     HStdOutput      => System.Null_Address,
     HStdError       => System.Null_Address);

   -- variables used
   Result              : Win32.BOOL;
   Server_Path         : Win32.LPCSTR := To_LPCSTR ("server_03.exe");
   Startup_Info        : Win32.Winbase.LPSTARTUPINFOA :=
     new Win32.Winbase.STARTUPINFOA'(Our_Startup);
   Process_Information : Win32.Winbase.LPPROCESS_INFORMATION :=
     new Win32.Winbase.PROCESS_INFORMATION;

   -- print an error message
   procedure Error_Message (S : String) is
      Result : Win32.DWORD;
   begin
      Result := Win32.Winbase.FormatMessage (
        DwFlags      => Win32.Winbase.FORMAT_MESSAGE_FROM_SYSTEM,
        LpSource     => System.Null_Address,
        DwMessageId  => Win32.Winbase.GetLastError,
        DwLanguageId => Interfaces.C.Unsigned_Long (Win32.Winnt.MAKELANGID
          (Win32.Winnt.LANG_NEUTRAL, Win32.Winnt.SUBLANG_DEFAULT)),
        LpBuffer     => Buffer,
        NSize        => Buffer_Size);
      Ada.Text_IO.Put (S & ": ");
      Ada.Text_IO.Put (Interfaces.C.Strings.Value (To_Chars_Ptr (Buffer)));
   end Error_Message;

begin

   -- starting program
   Ada.Text_IO.Put_Line ("Client_03 starting...");

   -- starting the server
   Ada.Text_IO.Put_Line ("Starting Server_03...");
   Result := Win32.Winbase.CreateProcess (
     lpApplicationName    => Server_Path,
     lpCommandline        => null,
     lpProcessAttributes  => null,
     lpThreadAttributes   => null,
     bInheritHandles      => Win32.FALSE,
     dwCreationFlags      => Win32.Winbase.CREATE_NEW_CONSOLE,
     lpEnvironment        => System.Null_Address,
     lpCurrentDirectory   => null,
     lpStartupInfo        => Startup_Info,
     lpProcessInformation => Process_Information);

   -- check if the server started
   if Result = Win32.FALSE then

      -- Whoops, our process didn't start
      Error_Message ("*** Server failed to start");

   else

      -- wait for server to finish
      Ada.Text_IO.Put_Line ("Waiting for Server_03 to finish");
      if Win32.Winbase.WaitForSingleObject (Process_Information.HProcess,
        Win32.Winbase.INFINITE) = Win32.Winbase.WAIT_FAILED then

         -- Oops, something went terribly wrong...
         Error_Message ("*** Waiting for server failed");

      else

         -- Ok, close the process handle for good
         Ada.Text_IO.Put_Line ("Server_03 finished properly");
         if Win32.Winbase.CloseHandle (Process_Information.HProcess) =
           Win32.False then

            -- Couldn't close the process handle
            Error_Message ("*** Failed to close the server process handle");

         else

            Ada.Text_IO.Put_Line ("Server_03 closed");

         end if;

      end if;

   end if;

   -- Done
   Ada.Text_IO.Put_Line ("Client_03 ending");
   Free (Buffer);
   Free (Server_Path);
   Free (Startup_Info);
   Free (Process_Information);

end Client_03;


-- 
-- Jerry van Dijk  | email: jdijk@acm.org
-- Leiden, Holland | member Team-Ada
-- Ada & Win32: http://stad.dsl.nl/~jvandyk