-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

------------------------------------------------------------------------------
-- This file has been derived from the standard version of this             --
-- package body in the GNAT runtime library.                                --
--                                                                          --
-- This package extends the standard package to support the multi-process   --
-- functionality required by SPARKSimp.                                     --
--                                                                          --
-- This package is a stop-gap measure until the multi-process functionality --
-- is supported in the standard GNAT sources.                               --
-- Below is the copyright notice from g-expect.adb                          --
--                                                                          --
--                     Copyright (C) 2000-2009, AdaCore                     --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
------------------------------------------------------------------------------

with System;                 use System;
with Ada.Calendar;           use Ada.Calendar;
with Ada.Characters.Latin_1;

with GNAT.IO;
with GNAT.OS_Lib;
with GNAT.Regpat; use GNAT.Regpat;

with Unchecked_Deallocation;

use type GNAT.OS_Lib.File_Descriptor;
use type GNAT.OS_Lib.String_Access;

package body SPARK.Expect is

   type Array_Of_Pd is array (Positive range <>) of Process_Descriptor_Access;

   procedure Expect_Internal
     (Descriptors : in out Array_Of_Pd;
      Result      :    out Expect_Match;
      Timeout     :        Integer;
      Full_Buffer :        Boolean);
   --  Internal function used to read from the process Descriptor.
   --
   --  Three outputs are possible:
   --     Result=Expect_Timeout, if no output was available before the timeout
   --        expired.
   --     Result=Expect_Full_Buffer, if Full_Buffer is True and some characters
   --        had to be discarded from the internal buffer of Descriptor.
   --     Result=<integer>, indicates how many characters were added to the
   --        internal buffer. These characters are from indexes
   --        Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index
   --  Process_Died is raised if the process is no longer valid.

   procedure New_Expect_Internal
     (Descriptors   : in out Array_Of_Pd;
      Result        :    out Expect_Match;
      Process_Index :    out Positive;
      Timeout       : in     Integer;
      Full_Buffer   : in     Boolean);
   --  Internal function used by New_Expect below
   --
   --  Three outputs are possible:
   --     Result=Expect_Timeout, if no output was available before the timeout
   --        expired.
   --     Result=Expect_Full_Buffer, if Full_Buffer is True and some characters
   --        had to be discarded from the internal buffer of Descriptor.
   --     Result=<integer>, indicates how many characters were added to the
   --        internal buffer. These characters are from indexes
   --        Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index
   --     Result=Expect_Process_Died
   --        When a process dies, this implementation return its descriptor
   --        index in Process_Index.  No exception is raised in this case.

   procedure New_Expect
     (Result        :    out Expect_Match;
      Process_Index :    out Positive;
      Regexps       : in     Multiprocess_Regexp_Array;
      Matched       :    out GNAT.Regpat.Match_Array;
      Timeout       : in     Integer                   := 10000;
      Full_Buffer   : in     Boolean                   := False);
   --  General purpose Expect, but return the index of the matched or
   --  terminated Process in Process_Index.  No exception is
   --  raised in this case.

   procedure Reinitialize_Buffer (Descriptor : in out Process_Descriptor'Class);
   --  Reinitialize the internal buffer.
   --  The buffer is deleted up to the end of the last match.

   procedure Free is new Unchecked_Deallocation (Pattern_Matcher, Pattern_Matcher_Access);

   procedure Free is new Unchecked_Deallocation (Filter_List_Elem, Filter_List);

   procedure Call_Filters (Pid       : Process_Descriptor'Class;
                           Str       : String;
                           Filter_On : Filter_Type);
   --  Call all the filters that have the appropriate type.
   --  This function does nothing if the filters are locked

   ------------------------------
   -- Target dependent section --
   ------------------------------

   function Dup (Fd : GNAT.OS_Lib.File_Descriptor) return GNAT.OS_Lib.File_Descriptor;
   pragma Import (C, Dup);

   procedure Dup2 (Old_Fd, New_Fd : GNAT.OS_Lib.File_Descriptor);
   pragma Import (C, Dup2);

   procedure Kill (Pid     : Process_Id;
                   Sig_Num : Integer;
                   Close   : Integer);
   pragma Import (C, Kill, "__gnat_kill");
   --  if Close is set to 1 all OS resources used by the Pid must be freed

   function Create_Pipe (Pipe : access Pipe_Type) return Integer;
   pragma Import (C, Create_Pipe, "__gnat_pipe");

   function Poll
     (Fds     : System.Address;
      Num_Fds : Integer;
      Timeout : Integer;
      Is_Set  : System.Address)
     return    Integer;
   pragma Import (C, Poll, "__gnat_expect_poll");
   --  Check whether there is any data waiting on the file descriptor
   --  Out_fd, and wait if there is none, at most Timeout milliseconds
   --  Returns -1 in case of error, 0 if the timeout expired before
   --  data became available.
   --
   --  Out_Is_Set is set to 1 if data was available, 0 otherwise.

   function New_Poll
     (Fds     : System.Address;
      Num_Fds : Integer;
      Timeout : Integer;
      Is_Set  : System.Address)
     return    Integer;
   pragma Import (C, New_Poll, "__new_expect_poll");
   --  Check whether there is any data waiting on the file descriptors
   --  denoted by Fds, and wait if there is none, at most Timeout milliseconds
   --
   --  The meaning of the return value differs between UNIX systems
   --  (which _do_ bother to implement select() properly) and Windows
   --  (which never has!)
   -------------------
   --  On UNIX platforms (e.g. Solaris, Linux, OS X/Darwin)
   --
   --  Returns a positive number indicating that number of descriptors are
   --  ready, and Is_Set (N)=1 if data is available on descriptor N.
   --
   --  If a sub-process N dies, then Is_Set (N)=1 BUT
   --  a subsequent call to GNAT.OS_Lib.Read on that descriptor will
   --  indicate End_of_File.
   --
   --  Returns 0 is no descriptors are ready AND the Timeout expires.
   --
   --  Returns -1 in the event of some other error.
   -------------------
   --  On Windows platforms
   --
   --  Returns 1 and Is_Set(N)=1 when data is available on descriptor N.
   --
   --  Returns 0 is no descriptors are ready AND the Timeout expires.
   --
   --  Returns -N in the case where the sub-process connected to
   --  descriptor N has died.
   -------------------

   function Waitpid (Pid : Process_Id) return Integer;
   pragma Import (C, Waitpid, "__gnat_waitpid");
   --  Wait for a specific process id, and return its exit code

   ---------
   -- "+" --
   ---------

   function "+" (S : String) return GNAT.OS_Lib.String_Access is
   begin
      return new String'(S);
   end "+";

   ---------
   -- "+" --
   ---------

   function "+" (P : GNAT.Regpat.Pattern_Matcher) return Pattern_Matcher_Access is
   begin
      return new GNAT.Regpat.Pattern_Matcher'(P);
   end "+";

   ----------------
   -- Add_Filter --
   ----------------

   procedure Add_Filter
     (Descriptor : in out Process_Descriptor;
      Filter     :        Filter_Function;
      Filter_On  :        Filter_Type        := Output;
      User_Data  :        System.Address     := System.Null_Address;
      After      :        Boolean            := False) is
      Current : Filter_List := Descriptor.Filters;

   begin
      if After then
         while Current /= null and then Current.Next /= null loop
            Current := Current.Next;
         end loop;

         if Current = null then
            Descriptor.Filters :=
              new Filter_List_Elem'(Filter    => Filter,
                                    Filter_On => Filter_On,
                                    User_Data => User_Data,
                                    Next      => null);
         else
            Current.Next := new Filter_List_Elem'(Filter    => Filter,
                                                  Filter_On => Filter_On,
                                                  User_Data => User_Data,
                                                  Next      => null);
         end if;

      else
         Descriptor.Filters :=
           new Filter_List_Elem'(Filter    => Filter,
                                 Filter_On => Filter_On,
                                 User_Data => User_Data,
                                 Next      => Descriptor.Filters);
      end if;
   end Add_Filter;

   ------------------
   -- Call_Filters --
   ------------------

   procedure Call_Filters (Pid       : Process_Descriptor'Class;
                           Str       : String;
                           Filter_On : Filter_Type) is
      Current_Filter : Filter_List;

   begin
      if Pid.Filters_Lock = 0 then
         Current_Filter := Pid.Filters;

         while Current_Filter /= null loop
            if Current_Filter.Filter_On = Filter_On then
               Current_Filter.Filter (Pid, Str, Current_Filter.User_Data);
            end if;

            Current_Filter := Current_Filter.Next;
         end loop;
      end if;
   end Call_Filters;

   -----------
   -- Close --
   -----------

   procedure Close (Descriptor : in out Process_Descriptor;
                    Status     :    out Integer) is
      Current_Filter : Filter_List;
      Next_Filter    : Filter_List;

   begin
      GNAT.OS_Lib.Close (Descriptor.Input_Fd);

      if Descriptor.Error_Fd /= Descriptor.Output_Fd then
         GNAT.OS_Lib.Close (Descriptor.Error_Fd);
      end if;

      GNAT.OS_Lib.Close (Descriptor.Output_Fd);

      --  ??? Should have timeouts for different signals

      Kill (Descriptor.Pid, 9, 0);

      GNAT.OS_Lib.Free (Descriptor.Buffer);
      Descriptor.Buffer_Size := 0;

      Current_Filter := Descriptor.Filters;

      while Current_Filter /= null loop
         Next_Filter := Current_Filter.Next;
         Free (Current_Filter);
         Current_Filter := Next_Filter;
      end loop;

      Descriptor.Filters := null;
      Status             := Waitpid (Descriptor.Pid);
   end Close;

   procedure Close (Descriptor : in out Process_Descriptor) is
      Status : Integer;
   begin
      Close (Descriptor, Status);
   end Close;

   ------------
   -- Expect --
   ------------

   procedure Expect
     (Descriptor  : in out Process_Descriptor;
      Result      :    out Expect_Match;
      Regexp      :        String;
      Timeout     :        Integer            := 10000;
      Full_Buffer :        Boolean            := False) is
   begin
      if Regexp = "" then
         Expect (Descriptor, Result, Never_Match, Timeout, Full_Buffer);
      else
         Expect (Descriptor, Result, Compile (Regexp), Timeout, Full_Buffer);
      end if;
   end Expect;

   procedure Expect
     (Descriptor  : in out Process_Descriptor;
      Result      :    out Expect_Match;
      Regexp      :        String;
      Matched     :    out GNAT.Regpat.Match_Array;
      Timeout     :        Integer                 := 10000;
      Full_Buffer :        Boolean                 := False) is
   begin
      pragma Assert (Matched'First = 0);
      if Regexp = "" then
         Expect (Descriptor, Result, Never_Match, Matched, Timeout, Full_Buffer);
      else
         Expect (Descriptor, Result, Compile (Regexp), Matched, Timeout, Full_Buffer);
      end if;
   end Expect;

   procedure Expect
     (Descriptor  : in out Process_Descriptor;
      Result      :    out Expect_Match;
      Regexp      :        GNAT.Regpat.Pattern_Matcher;
      Timeout     :        Integer                     := 10000;
      Full_Buffer :        Boolean                     := False) is
      Matched : GNAT.Regpat.Match_Array (0 .. 0);

   begin
      Expect (Descriptor, Result, Regexp, Matched, Timeout, Full_Buffer);
   end Expect;

   procedure Expect
     (Descriptor  : in out Process_Descriptor;
      Result      :    out Expect_Match;
      Regexp      :        GNAT.Regpat.Pattern_Matcher;
      Matched     :    out GNAT.Regpat.Match_Array;
      Timeout     :        Integer                     := 10000;
      Full_Buffer :        Boolean                     := False) is
      N           : Expect_Match;
      Descriptors : Array_Of_Pd   := (1 => Descriptor'Unrestricted_Access);
      Try_Until   : constant Time := Clock + Duration (Timeout) / 1000.0;
      Timeout_Tmp : Integer       := Timeout;

   begin
      pragma Assert (Matched'First = 0);
      Reinitialize_Buffer (Descriptor);

      loop
         --  First, test if what is already in the buffer matches (This is
         --  required if this package is used in multi-task mode, since one of
         --  the tasks might have added something in the buffer, and we don't
         --  want other tasks to wait for new input to be available before
         --  checking the regexps).

         Match (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);

         if Descriptor.Buffer_Index >= 1 and then Matched (0).First /= 0 then
            Result                      := 1;
            Descriptor.Last_Match_Start := Matched (0).First;
            Descriptor.Last_Match_End   := Matched (0).Last;
            return;
         end if;

         --  Else try to read new input

         Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer);

         if N = Expect_Timeout or else N = Expect_Full_Buffer then
            Result := N;
            return;
         end if;

         --  Calculate the timeout for the next turn

         --  Note that Timeout is, from the caller's perspective, the maximum
         --  time until a match, not the maximum time until some output is
         --  read, and thus cannot be reused as is for Expect_Internal.

         if Timeout /= -1 then
            Timeout_Tmp := Integer (Try_Until - Clock) * 1000;

            if Timeout_Tmp < 0 then
               Result := Expect_Timeout;
               exit;
            end if;
         end if;
      end loop;

      --  Even if we had the general timeout above, we have to test that the
      --  last test we read from the external process didn't match.

      Match (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);

      if Matched (0).First /= 0 then
         Result                      := 1;
         Descriptor.Last_Match_Start := Matched (0).First;
         Descriptor.Last_Match_End   := Matched (0).Last;
         return;
      end if;
   end Expect;

   procedure Expect
     (Descriptor  : in out Process_Descriptor;
      Result      :    out Expect_Match;
      Regexps     :        Regexp_Array;
      Timeout     :        Integer            := 10000;
      Full_Buffer :        Boolean            := False) is
      Patterns : Compiled_Regexp_Array (Regexps'Range);
      Matched  : GNAT.Regpat.Match_Array (0 .. 0);

   begin
      for J in Regexps'Range loop
         Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
      end loop;

      Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);

      for J in Regexps'Range loop
         Free (Patterns (J));
      end loop;
   end Expect;

   procedure Expect
     (Descriptor  : in out Process_Descriptor;
      Result      :    out Expect_Match;
      Regexps     :        Compiled_Regexp_Array;
      Timeout     :        Integer               := 10000;
      Full_Buffer :        Boolean               := False) is
      Matched : GNAT.Regpat.Match_Array (0 .. 0);

   begin
      Expect (Descriptor, Result, Regexps, Matched, Timeout, Full_Buffer);
   end Expect;

   procedure Expect
     (Result      : out Expect_Match;
      Regexps     :     Multiprocess_Regexp_Array;
      Timeout     :     Integer                   := 10000;
      Full_Buffer :     Boolean                   := False) is
      Matched : GNAT.Regpat.Match_Array (0 .. 0);

   begin
      Expect (Result, Regexps, Matched, Timeout, Full_Buffer);
   end Expect;

   procedure Expect
     (Result        :    out Expect_Match;
      Process_Index :    out Positive;
      Regexps       : in     Multiprocess_Regexp_Array;
      Timeout       : in     Integer                   := 10000;
      Full_Buffer   : in     Boolean                   := False) is
      Matched : GNAT.Regpat.Match_Array (0 .. 0);
   begin
      New_Expect (Result, Process_Index, Regexps, Matched, Timeout, Full_Buffer);
   end Expect;

   procedure Expect
     (Descriptor  : in out Process_Descriptor;
      Result      :    out Expect_Match;
      Regexps     :        Regexp_Array;
      Matched     :    out GNAT.Regpat.Match_Array;
      Timeout     :        Integer                 := 10000;
      Full_Buffer :        Boolean                 := False) is
      Patterns : Compiled_Regexp_Array (Regexps'Range);

   begin
      pragma Assert (Matched'First = 0);

      for J in Regexps'Range loop
         Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
      end loop;

      Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);

      for J in Regexps'Range loop
         Free (Patterns (J));
      end loop;
   end Expect;

   procedure Expect
     (Descriptor  : in out Process_Descriptor;
      Result      :    out Expect_Match;
      Regexps     :        Compiled_Regexp_Array;
      Matched     :    out GNAT.Regpat.Match_Array;
      Timeout     :        Integer                 := 10000;
      Full_Buffer :        Boolean                 := False) is
      N           : Expect_Match;
      Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);

   begin
      pragma Assert (Matched'First = 0);

      Reinitialize_Buffer (Descriptor);

      loop
         --  First, test if what is already in the buffer matches (This is
         --  required if this package is used in multi-task mode, since one of
         --  the tasks might have added something in the buffer, and we don't
         --  want other tasks to wait for new input to be available before
         --  checking the regexps).

         if Descriptor.Buffer /= null then
            for J in Regexps'Range loop
               Match (Regexps (J).all, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);

               if Matched (0) /= No_Match then
                  Result                      := Expect_Match (J);
                  Descriptor.Last_Match_Start := Matched (0).First;
                  Descriptor.Last_Match_End   := Matched (0).Last;
                  return;
               end if;
            end loop;
         end if;

         Expect_Internal (Descriptors, N, Timeout, Full_Buffer);

         if N = Expect_Timeout or else N = Expect_Full_Buffer then
            Result := N;
            return;
         end if;
      end loop;
   end Expect;

   procedure Expect
     (Result      : out Expect_Match;
      Regexps     :     Multiprocess_Regexp_Array;
      Matched     : out GNAT.Regpat.Match_Array;
      Timeout     :     Integer                   := 10000;
      Full_Buffer :     Boolean                   := False) is
      N           : Expect_Match;
      Descriptors : Array_Of_Pd (Regexps'Range);

   begin
      pragma Assert (Matched'First = 0);

      for J in Descriptors'Range loop
         Descriptors (J) := Regexps (J).Descriptor;
         Reinitialize_Buffer (Regexps (J).Descriptor.all);
      end loop;

      loop
         --  First, test if what is already in the buffer matches (This is
         --  required if this package is used in multi-task mode, since one of
         --  the tasks might have added something in the buffer, and we don't
         --  want other tasks to wait for new input to be available before
         --  checking the regexps).

         for J in Regexps'Range loop
            Match (Regexps (J).Regexp.all, Regexps (J).Descriptor.Buffer (1 .. Regexps (J).Descriptor.Buffer_Index), Matched);

            if Matched (0) /= No_Match then
               Result                                  := Expect_Match (J);
               Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
               Regexps (J).Descriptor.Last_Match_End   := Matched (0).Last;
               return;
            end if;
         end loop;

         Expect_Internal (Descriptors, N, Timeout, Full_Buffer);

         if N = Expect_Timeout or else N = Expect_Full_Buffer then
            Result := N;
            return;
         end if;
      end loop;
   end Expect;

   ----------------
   -- New_Expect --
   ----------------

   procedure New_Expect
     (Result        :    out Expect_Match;
      Process_Index :    out Positive;
      Regexps       : in     Multiprocess_Regexp_Array;
      Matched       :    out GNAT.Regpat.Match_Array;
      Timeout       : in     Integer                   := 10000;
      Full_Buffer   : in     Boolean                   := False) is
      N           : Expect_Match;
      Descriptors : Array_Of_Pd (Regexps'Range);

   begin
      pragma Assert (Matched'First = 0);

      for J in Descriptors'Range loop
         Descriptors (J) := Regexps (J).Descriptor;
         Reinitialize_Buffer (Regexps (J).Descriptor.all);
      end loop;

      loop
         --  First, test if what is already in the buffer matches (This is
         --  required if this package is used in multi-task mode, since one of
         --  the tasks might have added something in the buffer, and we don't
         --  want other tasks to wait for new input to be available before
         --  checking the regexps).

         for J in Regexps'Range loop
            Match (Regexps (J).Regexp.all, Regexps (J).Descriptor.Buffer (1 .. Regexps (J).Descriptor.Buffer_Index), Matched);

            if Matched (0) /= No_Match then
               Result                                  := Expect_Match (J);
               Process_Index                           := J;
               Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
               Regexps (J).Descriptor.Last_Match_End   := Matched (0).Last;
               return;
            end if;
         end loop;

         New_Expect_Internal (Descriptors, N, Process_Index, Timeout, Full_Buffer);

         --  Repeat until Timeout, full buffer, or process(es) died
         if N = Expect_Timeout or else N = Expect_Full_Buffer or else N = Expect_Process_Died then

            Result := N;
            return;
         end if;
      end loop;
   end New_Expect;

   ---------------------
   -- Expect_Internal --
   ---------------------

   procedure Expect_Internal
     (Descriptors : in out Array_Of_Pd;
      Result      :    out Expect_Match;
      Timeout     :        Integer;
      Full_Buffer :        Boolean) is
      Num_Descriptors : Integer;
      Buffer_Size     : Integer := 0;

      N : Integer;

      type File_Descriptor_Array is array (Descriptors'Range) of GNAT.OS_Lib.File_Descriptor;
      Fds : aliased File_Descriptor_Array;

      type Integer_Array is array (Descriptors'Range) of Integer;
      Is_Set : aliased Integer_Array;

   begin
      for J in Descriptors'Range loop
         Fds (J) := Descriptors (J).Output_Fd;

         if Descriptors (J).Buffer_Size = 0 then
            Buffer_Size := Integer'Max (Buffer_Size, 4096);
         else
            Buffer_Size := Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
         end if;
      end loop;

      declare
         Buffer : aliased String (1 .. Buffer_Size);
         --  Buffer used for input. This is allocated only once, not for
         --  every iteration of the loop

      begin
         --  Loop until we match or we have a timeout

         loop
            Num_Descriptors := Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address);

            case Num_Descriptors is

               --  Error?

               when -1 =>
                  raise Process_Died;

                  --  Timeout?

               when 0 =>
                  Result := Expect_Timeout;
                  return;

                  --  Some input

               when others =>
                  for J in Descriptors'Range loop
                     if Is_Set (J) = 1 then
                        Buffer_Size := Descriptors (J).Buffer_Size;

                        if Buffer_Size = 0 then
                           Buffer_Size := 4096;
                        end if;

                        N := GNAT.OS_Lib.Read (Descriptors (J).Output_Fd, Buffer'Address, Buffer_Size);

                        --  Error or End of file

                        if N <= 0 then
                           --  ??? Note that ddd tries again up to three times
                           --  in that case. See LiterateA.C:174
                           raise Process_Died;

                        else
                           --  If there is no limit to the buffer size

                           if Descriptors (J).Buffer_Size = 0 then

                              declare
                                 Tmp : GNAT.OS_Lib.String_Access := Descriptors (J).Buffer;
                              begin
                                 if Tmp /= null then
                                    Descriptors (J).Buffer                                    := new String (1 .. Tmp'Length + N);
                                    Descriptors (J).Buffer (1 .. Tmp'Length)                  := Tmp.all;
                                    Descriptors (J).Buffer (Tmp'Length + 1 .. Tmp'Length + N) := Buffer (1 .. N);
                                    GNAT.OS_Lib.Free (Tmp);
                                    Descriptors (J).Buffer_Index := Descriptors (J).Buffer'Last;

                                 else
                                    Descriptors (J).Buffer       := new String (1 .. N);
                                    Descriptors (J).Buffer.all   := Buffer (1 .. N);
                                    Descriptors (J).Buffer_Index := N;
                                 end if;
                              end;

                           else
                              --  Add what we read to the buffer

                              if Descriptors (J).Buffer_Index + N - 1 > Descriptors (J).Buffer_Size then
                                 --  If the user wants to know when we have
                                 --  read more than the buffer can contain.

                                 if Full_Buffer then
                                    Result := Expect_Full_Buffer;
                                    return;
                                 end if;

                                 --  Keep as much as possible from the buffer,
                                 --  and forget old characters.

                                 Descriptors (J).Buffer (1 .. Descriptors (J).Buffer_Size - N) :=
                                   Descriptors (J).Buffer (
                                                           N - Descriptors (J).Buffer_Size + Descriptors (J).Buffer_Index + 1 ..
                                                             Descriptors (J).Buffer_Index);
                                 Descriptors (J).Buffer_Index                                  := Descriptors (J).Buffer_Size - N;
                              end if;

                              --  Keep what we read in the buffer

                              Descriptors (J).Buffer (Descriptors (J).Buffer_Index + 1 .. Descriptors (J).Buffer_Index + N) :=
                                Buffer (1 .. N);
                              Descriptors (J).Buffer_Index                                                                  :=
                                Descriptors (J).Buffer_Index + N;
                           end if;

                           --  Call each of the output filter with what we
                           --  read.

                           Call_Filters (Descriptors (J).all, Buffer (1 .. N), Output);

                           Result := Expect_Match (N);
                           return;
                        end if;
                     end if;
                  end loop;
            end case;
         end loop;
      end;
   end Expect_Internal;

   -------------------------
   -- New_Expect_Internal --
   -------------------------

   procedure New_Expect_Internal
     (Descriptors   : in out Array_Of_Pd;
      Result        :    out Expect_Match;
      Process_Index :    out Positive;
      Timeout       : in     Integer;
      Full_Buffer   : in     Boolean) is
      Num_Descriptors : Integer;
      Buffer_Size     : Integer := 0;

      N : Integer;

      type File_Descriptor_Array is array (Descriptors'Range) of GNAT.OS_Lib.File_Descriptor;
      Fds : aliased File_Descriptor_Array;

      type Integer_Array is array (Descriptors'Range) of Integer;
      Is_Set : aliased Integer_Array;

   begin
      Process_Index := Positive'First;

      for J in Descriptors'Range loop
         Fds (J) := Descriptors (J).Output_Fd;

         if Descriptors (J).Buffer_Size = 0 then
            Buffer_Size := Integer'Max (Buffer_Size, 4096);
         else
            Buffer_Size := Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
         end if;
      end loop;

      declare
         Buffer : aliased String (1 .. Buffer_Size);
         --  Buffer used for input. This is allocated only once, not for
         --  every iteration of the loop

      begin
         --  Loop until we match or we have a timeout

         loop
            Num_Descriptors := New_Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address);

            case Num_Descriptors is

               --  Error?

               when Integer'First .. -1 =>
                  --  On Windows, a negative number -N indicates that process
                  --  in slot N has died.  Return this info to the caller.
                  Result      := Expect_Process_Died;
                  Process_Index := -Num_Descriptors;
                  return;

                  --  Timeout?

               when 0 =>
                  Result := Expect_Timeout;
                  return;

                  --  Some input

               when others =>
                  for J in Descriptors'Range loop
                     if Is_Set (J) = 1 then
                        Buffer_Size := Descriptors (J).Buffer_Size;

                        if Buffer_Size = 0 then
                           Buffer_Size := 4096;
                        end if;

                        N := GNAT.OS_Lib.Read (Descriptors (J).Output_Fd, Buffer'Address, Buffer_Size);

                        if N <= 0 then
                           --  On Unix platforms, the read can fail here
                           --  if a subprocess has died.
                           --  Indicate this back to the caller via Result
                           --  and Process_Index
                           Result        := Expect_Process_Died;
                           Process_Index := J;
                           return;

                        else
                           --  If there is no limit to the buffer size

                           if Descriptors (J).Buffer_Size = 0 then

                              declare
                                 Tmp : GNAT.OS_Lib.String_Access := Descriptors (J).Buffer;
                              begin
                                 if Tmp /= null then
                                    Descriptors (J).Buffer                                    := new String (1 .. Tmp'Length + N);
                                    Descriptors (J).Buffer (1 .. Tmp'Length)                  := Tmp.all;
                                    Descriptors (J).Buffer (Tmp'Length + 1 .. Tmp'Length + N) := Buffer (1 .. N);
                                    GNAT.OS_Lib.Free (Tmp);
                                    Descriptors (J).Buffer_Index := Descriptors (J).Buffer'Last;

                                 else
                                    Descriptors (J).Buffer       := new String (1 .. N);
                                    Descriptors (J).Buffer.all   := Buffer (1 .. N);
                                    Descriptors (J).Buffer_Index := N;
                                 end if;
                              end;

                           else
                              --  Add what we read to the buffer

                              if Descriptors (J).Buffer_Index + N - 1 > Descriptors (J).Buffer_Size then
                                 --  If the user wants to know when we have
                                 --  read more than the buffer can contain.

                                 if Full_Buffer then
                                    Result        := Expect_Full_Buffer;
                                    Process_Index := J;
                                    return;
                                 end if;

                                 --  Keep as much as possible from the buffer,
                                 --  and forget old characters.

                                 Descriptors (J).Buffer (1 .. Descriptors (J).Buffer_Size - N) :=
                                   Descriptors (J).Buffer (
                                                           N - Descriptors (J).Buffer_Size + Descriptors (J).Buffer_Index + 1 ..
                                                             Descriptors (J).Buffer_Index);
                                 Descriptors (J).Buffer_Index                                  := Descriptors (J).Buffer_Size - N;
                              end if;

                              --  Keep what we read in the buffer

                              Descriptors (J).Buffer (Descriptors (J).Buffer_Index + 1 .. Descriptors (J).Buffer_Index + N) :=
                                Buffer (1 .. N);
                              Descriptors (J).Buffer_Index                                                                  :=
                                Descriptors (J).Buffer_Index + N;
                           end if;

                           --  Call each of the output filter with what we
                           --  read.

                           Call_Filters (Descriptors (J).all, Buffer (1 .. N), Output);

                           Result        := Expect_Match (N);
                           Process_Index := J;
                           return;
                        end if;
                     end if;
                  end loop;
            end case;
         end loop;
      end;
   end New_Expect_Internal;

   ----------------
   -- Expect_Out --
   ----------------

   function Expect_Out (Descriptor : Process_Descriptor) return String is
   begin
      return Descriptor.Buffer (1 .. Descriptor.Last_Match_End);
   end Expect_Out;

   ----------------------
   -- Expect_Out_Match --
   ----------------------

   function Expect_Out_Match (Descriptor : Process_Descriptor) return String is
   begin
      return Descriptor.Buffer (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
   end Expect_Out_Match;

   -----------
   -- Flush --
   -----------

   procedure Flush (Descriptor : in out Process_Descriptor;
                    Timeout    :        Integer            := 0) is
      Buffer_Size     : constant Integer := 8192;
      Num_Descriptors : Integer;
      N               : Integer;
      Is_Set          : aliased Integer;
      Buffer          : aliased String (1 .. Buffer_Size);

   begin
      --  Empty the current buffer

      Descriptor.Last_Match_End := Descriptor.Buffer_Index;
      Reinitialize_Buffer (Descriptor);

      --  Read everything from the process to flush its output

      loop
         Num_Descriptors := Poll (Descriptor.Output_Fd'Address, 1, Timeout, Is_Set'Address);

         case Num_Descriptors is

            --  Error ?

            when -1 =>
               raise Process_Died;

               --  Timeout => End of flush

            when 0 =>
               return;

               --  Some input

            when others =>
               if Is_Set = 1 then
                  N := GNAT.OS_Lib.Read (Descriptor.Output_Fd, Buffer'Address, Buffer_Size);

                  if N = -1 then
                     raise Process_Died;
                  elsif N = 0 then
                     return;
                  end if;
               end if;
         end case;
      end loop;
   end Flush;

   ------------------------
   -- Get_Command_Output --
   ------------------------

   function Get_Command_Output
     (Command    :        String;
      Arguments  :        GNAT.OS_Lib.Argument_List;
      Input      :        String;
      Status     : access Integer;
      Err_To_Out :        Boolean                   := False)
     return       String
   is
      Process : Process_Descriptor;

      Output : GNAT.OS_Lib.String_Access := new String (1 .. 1024);
      --  Buffer used to accumulate standard output from the launched
      --  command, expanded as necessary during execution.

      Last : Integer := 0;
      --  Index of the last used character within Output

   begin
      Non_Blocking_Spawn (Descriptor => Process,
                          Command    => Command,
                          Args       => Arguments,
                          Err_To_Out => Err_To_Out);

      if Input'Length > 0 then
         Send (Process, Input);
      end if;

      GNAT.OS_Lib.Close (Get_Input_Fd (Process));

      declare
         Result : Expect_Match;

      begin
         --  This loop runs until the call to Expect raises Process_Died

         loop
            Expect (Process, Result, ".+");

            declare
               NOutput : GNAT.OS_Lib.String_Access;
               S       : constant String := Expect_Out (Process);
               pragma Assert (S'Length > 0);

            begin
               --  Expand buffer if we need more space

               if Last + S'Length > Output'Last then
                  NOutput                := new String (1 .. 2 * Output'Last);
                  NOutput (Output'Range) := Output.all;
                  GNAT.OS_Lib.Free (Output);

                  --  Here if current buffer size is OK

               else
                  NOutput := Output;
               end if;

               NOutput (Last + 1 .. Last + S'Length) := S;
               Last                                  := Last + S'Length;
               Output                                := NOutput;
            end;
         end loop;

      exception
         when Process_Died =>
            Close (Process, Status.all);
      end;

      if Last = 0 then
         return "";
      end if;

      declare
         S : constant String := Output (1 .. Last);
      begin
         GNAT.OS_Lib.Free (Output);
         return S;
      end;
   end Get_Command_Output;

   ------------------
   -- Get_Error_Fd --
   ------------------

   function Get_Error_Fd (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
   begin
      return Descriptor.Error_Fd;
   end Get_Error_Fd;

   ------------------
   -- Get_Input_Fd --
   ------------------

   function Get_Input_Fd (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
   begin
      return Descriptor.Input_Fd;
   end Get_Input_Fd;

   -------------------
   -- Get_Output_Fd --
   -------------------

   function Get_Output_Fd (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
   begin
      return Descriptor.Output_Fd;
   end Get_Output_Fd;

   -------------
   -- Get_Pid --
   -------------

   function Get_Pid (Descriptor : Process_Descriptor) return Process_Id is
   begin
      return Descriptor.Pid;
   end Get_Pid;

   ---------------
   -- Interrupt --
   ---------------

   procedure Interrupt (Descriptor : in out Process_Descriptor) is
      SIGINT : constant := 2;

   begin
      Send_Signal (Descriptor, SIGINT);
   end Interrupt;

   ------------------
   -- Lock_Filters --
   ------------------

   procedure Lock_Filters (Descriptor : in out Process_Descriptor) is
   begin
      Descriptor.Filters_Lock := Descriptor.Filters_Lock + 1;
   end Lock_Filters;

   ------------------------
   -- Non_Blocking_Spawn --
   ------------------------

   procedure Non_Blocking_Spawn
     (Descriptor  : out Process_Descriptor'Class;
      Command     :     String;
      Args        :     GNAT.OS_Lib.Argument_List;
      Buffer_Size :     Natural                   := 4096;
      Err_To_Out  :     Boolean                   := False) is
      function Fork return Process_Id;
      pragma Import (C, Fork, "__gnat_expect_fork");
      --  Starts a new process if possible. See the Unix command fork for more
      --  information. On systems that do not support this capability (such as
      --  Windows...), this command does nothing, and Fork will return
      --  Null_Pid.

      Pipe1, Pipe2, Pipe3 : aliased Pipe_Type;

      Arg        : GNAT.OS_Lib.String_Access;
      Arg_List   : GNAT.OS_Lib.String_List (1 .. Args'Length + 2);
      C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address;

      Command_With_Path : GNAT.OS_Lib.String_Access;

   begin
      --  Create the rest of the pipes

      Set_Up_Communications (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);

      Command_With_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Command);

      if Command_With_Path = null then
         raise Invalid_Process;
      end if;

      --  Fork a new process

      Descriptor.Pid := Fork;

      --  Are we now in the child (or, for Windows, still in the common
      --  process).

      if Descriptor.Pid = Null_Pid then
         --  Prepare an array of arguments to pass to C

         Arg                                 := new String (1 .. Command_With_Path'Length + 1);
         Arg (1 .. Command_With_Path'Length) := Command_With_Path.all;
         Arg (Arg'Last)                      := Ada.Characters.Latin_1.NUL;
         Arg_List (1)                        := Arg;

         for J in Args'Range loop
            Arg                           := new String (1 .. Args (J)'Length + 1);
            Arg (1 .. Args (J)'Length)    := Args (J).all;
            Arg (Arg'Last)                := Ada.Characters.Latin_1.NUL;
            Arg_List (J + 2 - Args'First) := Arg.all'Access;
         end loop;

         Arg_List (Arg_List'Last) := null;

         --  Make sure all arguments are compatible with OS conventions

         GNAT.OS_Lib.Normalize_Arguments (Arg_List);

         --  Prepare low-level argument list from the normalized arguments

         for K in Arg_List'Range loop
            if Arg_List (K) /= null then
               C_Arg_List (K) := Arg_List (K).all'Address;
            else
               C_Arg_List (K) := System.Null_Address;
            end if;
         end loop;

         --  This does not return on Unix systems

         Set_Up_Child_Communications (Descriptor, Pipe1, Pipe2, Pipe3, Command_With_Path.all, C_Arg_List'Address);
      end if;

      GNAT.OS_Lib.Free (Command_With_Path);

      --  Did we have an error when spawning the child ?

      if Descriptor.Pid < Null_Pid then
         raise Invalid_Process;
      else
         --  We are now in the parent process

         Set_Up_Parent_Communications (Descriptor, Pipe1, Pipe2, Pipe3);
      end if;

      --  Create the buffer

      Descriptor.Buffer_Size := Buffer_Size;

      if Buffer_Size /= 0 then
         Descriptor.Buffer := new String (1 .. Positive (Buffer_Size));
      end if;

      --  Initialize the filters

      Descriptor.Filters := null;
   end Non_Blocking_Spawn;

   -------------------------
   -- Reinitialize_Buffer --
   -------------------------

   procedure Reinitialize_Buffer (Descriptor : in out Process_Descriptor'Class) is
   begin
      if Descriptor.Buffer_Size = 0 then
         declare
            Tmp : GNAT.OS_Lib.String_Access := Descriptor.Buffer;

         begin
            Descriptor.Buffer := new String (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End);

            if Tmp /= null then
               Descriptor.Buffer.all := Tmp (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
               GNAT.OS_Lib.Free (Tmp);
            end if;
         end;

         Descriptor.Buffer_Index := Descriptor.Buffer'Last;

      else
         Descriptor.Buffer (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End) :=
           Descriptor.Buffer (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);

         if Descriptor.Buffer_Index > Descriptor.Last_Match_End then
            Descriptor.Buffer_Index := Descriptor.Buffer_Index - Descriptor.Last_Match_End;
         else
            Descriptor.Buffer_Index := 0;
         end if;
      end if;

      Descriptor.Last_Match_Start := 0;
      Descriptor.Last_Match_End   := 0;
   end Reinitialize_Buffer;

   -------------------
   -- Remove_Filter --
   -------------------

   procedure Remove_Filter (Descriptor : in out Process_Descriptor;
                            Filter     :        Filter_Function) is
      Previous : Filter_List := null;
      Current  : Filter_List := Descriptor.Filters;

   begin
      while Current /= null loop
         if Current.Filter = Filter then
            if Previous = null then
               Descriptor.Filters := Current.Next;
            else
               Previous.Next := Current.Next;
            end if;
         end if;

         Previous := Current;
         Current  := Current.Next;
      end loop;
   end Remove_Filter;

   ----------
   -- Send --
   ----------

   procedure Send
     (Descriptor   : in out Process_Descriptor;
      Str          :        String;
      Add_LF       :        Boolean            := True;
      Empty_Buffer :        Boolean            := False) is
      Full_Str    : constant String := Str & Ada.Characters.Latin_1.LF;
      Last        : Natural;
      Result      : Expect_Match;
      Descriptors : Array_Of_Pd     := (1 => Descriptor'Unrestricted_Access);

      Dummy : Natural;
      pragma Unreferenced (Dummy);

   begin
      if Empty_Buffer then

         --  Force a read on the process if there is anything waiting

         Expect_Internal (Descriptors => Descriptors,
                          Result      => Result,
                          Timeout     => 0,
                          Full_Buffer => False);

         Descriptor.Last_Match_End := Descriptor.Buffer_Index;

         --  Empty the buffer

         Reinitialize_Buffer (Descriptor);
      end if;

      if Add_LF then
         Last := Full_Str'Last;
      else
         Last := Full_Str'Last - 1;
      end if;

      Call_Filters (Descriptor, Full_Str (Full_Str'First .. Last), Input);

      Dummy := GNAT.OS_Lib.Write (Descriptor.Input_Fd, Full_Str'Address, Last - Full_Str'First + 1);
   end Send;

   -----------------
   -- Send_Signal --
   -----------------

   procedure Send_Signal (Descriptor : Process_Descriptor;
                          Signal     : Integer) is
   begin
      Kill (Descriptor.Pid, Signal, 1);
      --  ??? Need to check process status here
   end Send_Signal;

   ---------------------------------
   -- Set_Up_Child_Communications --
   ---------------------------------

   procedure Set_Up_Child_Communications
     (Pid   : in out Process_Descriptor;
      Pipe1 : in out Pipe_Type;
      Pipe2 : in out Pipe_Type;
      Pipe3 : in out Pipe_Type;
      Cmd   :        String;
      Args  :        System.Address) is
      pragma Warnings (Off, Pid);

      Input  : GNAT.OS_Lib.File_Descriptor;
      Output : GNAT.OS_Lib.File_Descriptor;
      Error  : GNAT.OS_Lib.File_Descriptor;

   begin
      --  Since Windows does not have a separate fork/exec, we need to
      --  perform the following actions:
      --    - save stdin, stdout, stderr
      --    - replace them by our pipes
      --    - create the child with process handle inheritance
      --    - revert to the previous stdin, stdout and stderr.

      Input  := Dup (GNAT.OS_Lib.Standin);
      Output := Dup (GNAT.OS_Lib.Standout);
      Error  := Dup (GNAT.OS_Lib.Standerr);

      --  Since we are still called from the parent process, there is no way
      --  currently we can cleanly close the unneeded ends of the pipes, but
      --  this doesn't really matter.
      --  We could close Pipe1.Output, Pipe2.Input, Pipe3.Input.

      Dup2 (Pipe1.Input, GNAT.OS_Lib.Standin);
      Dup2 (Pipe2.Output, GNAT.OS_Lib.Standout);
      Dup2 (Pipe3.Output, GNAT.OS_Lib.Standerr);

      Portable_Execvp (Pid.Pid'Access, Cmd & Ada.Characters.Latin_1.NUL, Args);

      --  The following commands are not executed on Unix systems, and are
      --  only required for Windows systems. We are now in the parent process.

      --  Restore the old descriptors

      Dup2 (Input, GNAT.OS_Lib.Standin);
      Dup2 (Output, GNAT.OS_Lib.Standout);
      Dup2 (Error, GNAT.OS_Lib.Standerr);
      GNAT.OS_Lib.Close (Input);
      GNAT.OS_Lib.Close (Output);
      GNAT.OS_Lib.Close (Error);
   end Set_Up_Child_Communications;

   ---------------------------
   -- Set_Up_Communications --
   ---------------------------

   procedure Set_Up_Communications
     (Pid        : in out Process_Descriptor;
      Err_To_Out :        Boolean;
      Pipe1      : access Pipe_Type;
      Pipe2      : access Pipe_Type;
      Pipe3      : access Pipe_Type) is
      procedure Set_Close_On_Exec (FD            :     GNAT.OS_Lib.File_Descriptor;
                                   Close_On_Exec :     Boolean;
                                   Status        : out Boolean);

      procedure Set_Close_On_Exec (FD            :     GNAT.OS_Lib.File_Descriptor;
                                   Close_On_Exec :     Boolean;
                                   Status        : out Boolean) is
      begin
         GNAT.OS_Lib.Set_Close_On_Exec (FD, Close_On_Exec, Status);
      end Set_Close_On_Exec;

      Status : Boolean;
      pragma Unreferenced (Status);
   begin
      --  Create the pipes

      if Create_Pipe (Pipe1) /= 0 then
         return;
      end if;

      if Create_Pipe (Pipe2) /= 0 then
         return;
      end if;

      --  Record the 'parent' end of the two pipes in Pid:
      --    Child stdin  is connected to the 'write' end of Pipe1;
      --    Child stdout is connected to the 'read'  end of Pipe2.
      --  We do not want these descriptors to remain open in the child
      --  process, so we mark them close-on-exec/non-inheritable.

      Pid.Input_Fd := Pipe1.Output;

      Set_Close_On_Exec (Pipe1.Output, True, Status);
      Pid.Output_Fd := Pipe2.Input;
      Set_Close_On_Exec (Pipe2.Input, True, Status);

      if Err_To_Out then

         --  Reuse the standard output pipe for standard error

         Pipe3.all := Pipe2.all;
      else

         --  Create a separate pipe for standard error

         if Create_Pipe (Pipe3) /= 0 then
            return;
         end if;
      end if;

      --  As above, we record the proper fd for the child's
      --  standard error stream.

      Pid.Error_Fd := Pipe3.Input;
      Set_Close_On_Exec (Pipe3.Input, True, Status);
   end Set_Up_Communications;

   ----------------------------------
   -- Set_Up_Parent_Communications --
   ----------------------------------

   procedure Set_Up_Parent_Communications
     (Pid   : in out Process_Descriptor;
      Pipe1 : in out Pipe_Type;
      Pipe2 : in out Pipe_Type;
      Pipe3 : in out Pipe_Type) is
      pragma Warnings (Off, Pid);

   begin
      GNAT.OS_Lib.Close (Pipe1.Input);
      GNAT.OS_Lib.Close (Pipe2.Output);
      GNAT.OS_Lib.Close (Pipe3.Output);
   end Set_Up_Parent_Communications;

   ------------------
   -- Trace_Filter --
   ------------------

   procedure Trace_Filter
     (Descriptor : Process_Descriptor'Class;
      Str        : String;
      User_Data  : System.Address           := System.Null_Address) is
      pragma Warnings (Off, Descriptor);
      pragma Warnings (Off, User_Data);

   begin
      GNAT.IO.Put (Str);
   end Trace_Filter;

   --------------------
   -- Unlock_Filters --
   --------------------

   procedure Unlock_Filters (Descriptor : in out Process_Descriptor) is
   begin
      if Descriptor.Filters_Lock > 0 then
         Descriptor.Filters_Lock := Descriptor.Filters_Lock - 1;
      end if;
   end Unlock_Filters;

end SPARK.Expect;
