gcc/ada/g-expect.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --                          G N A T . E X P E C T                           --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2000-2010, AdaCore                     --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with System;              use System;
  35 with System.OS_Constants; use System.OS_Constants;
  36 with Ada.Calendar;        use Ada.Calendar;
  37
  38 with GNAT.IO;
  39 with GNAT.OS_Lib;  use GNAT.OS_Lib;
  40 with GNAT.Regpat;  use GNAT.Regpat;
  41
  42 with Ada.Unchecked_Deallocation;
  43
  44 package body GNAT.Expect is
  45
  46    type Array_Of_Pd is array (Positive range <>) of Process_Descriptor_Access;
  47
  48    Expect_Process_Died   : constant Expect_Match := -100;
  49    Expect_Internal_Error : constant Expect_Match := -101;
  50    --  Additional possible outputs of Expect_Internal. These are not visible in
  51    --  the spec because the user will never see them.
  52
  53    procedure Expect_Internal
  54      (Descriptors : in out Array_Of_Pd;
  55       Result      : out Expect_Match;
  56       Timeout     : Integer;
  57       Full_Buffer : Boolean);
  58    --  Internal function used to read from the process Descriptor.
  59    --
  60    --  Several outputs are possible:
  61    --     Result=Expect_Timeout, if no output was available before the timeout
  62    --        expired.
  63    --     Result=Expect_Full_Buffer, if Full_Buffer is True and some characters
  64    --        had to be discarded from the internal buffer of Descriptor.
  65    --     Result=Express_Process_Died if one of the processes was terminated.
  66    --        That process's Input_Fd is set to Invalid_FD
  67    --     Result=Express_Internal_Error
  68    --     Result=<integer>, indicates how many characters were added to the
  69    --        internal buffer. These characters are from indexes
  70    --        Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index
  71    --  Process_Died is raised if the process is no longer valid.
  72
  73    procedure Reinitialize_Buffer
  74      (Descriptor : in out Process_Descriptor'Class);
  75    --  Reinitialize the internal buffer.
  76    --  The buffer is deleted up to the end of the last match.
  77
  78    procedure Free is new Ada.Unchecked_Deallocation
  79      (Pattern_Matcher, Pattern_Matcher_Access);
  80
  81    procedure Free is new Ada.Unchecked_Deallocation
  82      (Filter_List_Elem, Filter_List);
  83
  84    procedure Call_Filters
  85      (Pid       : Process_Descriptor'Class;
  86       Str       : String;
  87       Filter_On : Filter_Type);
  88    --  Call all the filters that have the appropriate type.
  89    --  This function does nothing if the filters are locked
  90
  91    ------------------------------
  92    -- Target dependent section --
  93    ------------------------------
  94
  95    function Dup (Fd : File_Descriptor) return File_Descriptor;
  96    pragma Import (C, Dup);
  97
  98    procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
  99    pragma Import (C, Dup2);
 100
 101    procedure Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer);
 102    pragma Import (C, Kill, "__gnat_kill");
 103    --  if Close is set to 1 all OS resources used by the Pid must be freed
 104
 105    function Create_Pipe (Pipe : not null access Pipe_Type) return Integer;
 106    pragma Import (C, Create_Pipe, "__gnat_pipe");
 107
 108    function Poll
 109      (Fds     : System.Address;
 110       Num_Fds : Integer;
 111       Timeout : Integer;
 112       Is_Set  : System.Address) return Integer;
 113    pragma Import (C, Poll, "__gnat_expect_poll");
 114    --  Check whether there is any data waiting on the file descriptor
 115    --  Out_fd, and wait if there is none, at most Timeout milliseconds
 116    --  Returns -1 in case of error, 0 if the timeout expired before
 117    --  data became available.
 118    --
 119    --  Out_Is_Set is set to 1 if data was available, 0 otherwise.
 120
 121    function Waitpid (Pid : Process_Id) return Integer;
 122    pragma Import (C, Waitpid, "__gnat_waitpid");
 123    --  Wait for a specific process id, and return its exit code
 124
 125    ---------
 126    -- "+" --
 127    ---------
 128
 129    function "+" (S : String) return GNAT.OS_Lib.String_Access is
 130    begin
 131       return new String'(S);
 132    end "+";
 133
 134    ---------
 135    -- "+" --
 136    ---------
 137
 138    function "+"
 139      (P : GNAT.Regpat.Pattern_Matcher) return Pattern_Matcher_Access
 140    is
 141    begin
 142       return new GNAT.Regpat.Pattern_Matcher'(P);
 143    end "+";
 144
 145    ----------------
 146    -- Add_Filter --
 147    ----------------
 148
 149    procedure Add_Filter
 150      (Descriptor : in out Process_Descriptor;
 151       Filter     : Filter_Function;
 152       Filter_On  : Filter_Type := Output;
 153       User_Data  : System.Address := System.Null_Address;
 154       After      : Boolean := False)
 155    is
 156       Current : Filter_List := Descriptor.Filters;
 157
 158    begin
 159       if After then
 160          while Current /= null and then Current.Next /= null loop
 161             Current := Current.Next;
 162          end loop;
 163
 164          if Current = null then
 165             Descriptor.Filters :=
 166               new Filter_List_Elem'
 167                (Filter => Filter, Filter_On => Filter_On,
 168                 User_Data => User_Data, Next => null);
 169          else
 170             Current.Next :=
 171               new Filter_List_Elem'
 172               (Filter => Filter, Filter_On => Filter_On,
 173                User_Data => User_Data, Next => null);
 174          end if;
 175
 176       else
 177          Descriptor.Filters :=
 178            new Filter_List_Elem'
 179              (Filter => Filter, Filter_On => Filter_On,
 180               User_Data => User_Data, Next => Descriptor.Filters);
 181       end if;
 182    end Add_Filter;
 183
 184    ------------------
 185    -- Call_Filters --
 186    ------------------
 187
 188    procedure Call_Filters
 189      (Pid       : Process_Descriptor'Class;
 190       Str       : String;
 191       Filter_On : Filter_Type)
 192    is
 193       Current_Filter  : Filter_List;
 194
 195    begin
 196       if Pid.Filters_Lock = 0 then
 197          Current_Filter := Pid.Filters;
 198
 199          while Current_Filter /= null loop
 200             if Current_Filter.Filter_On = Filter_On then
 201                Current_Filter.Filter
 202                  (Pid, Str, Current_Filter.User_Data);
 203             end if;
 204
 205             Current_Filter := Current_Filter.Next;
 206          end loop;
 207       end if;
 208    end Call_Filters;
 209
 210    -----------
 211    -- Close --
 212    -----------
 213
 214    procedure Close
 215      (Descriptor : in out Process_Descriptor;
 216       Status     : out Integer)
 217    is
 218       Current_Filter : Filter_List;
 219       Next_Filter    : Filter_List;
 220
 221    begin
 222       if Descriptor.Input_Fd /= Invalid_FD then
 223          Close (Descriptor.Input_Fd);
 224       end if;
 225
 226       if Descriptor.Error_Fd /= Descriptor.Output_Fd then
 227          Close (Descriptor.Error_Fd);
 228       end if;
 229
 230       Close (Descriptor.Output_Fd);
 231
 232       --  ??? Should have timeouts for different signals
 233
 234       if Descriptor.Pid > 0 then  --  see comment in Send_Signal
 235          Kill (Descriptor.Pid, Sig_Num => 9, Close => 0);
 236       end if;
 237
 238       GNAT.OS_Lib.Free (Descriptor.Buffer);
 239       Descriptor.Buffer_Size := 0;
 240
 241       Current_Filter := Descriptor.Filters;
 242
 243       while Current_Filter /= null loop
 244          Next_Filter := Current_Filter.Next;
 245          Free (Current_Filter);
 246          Current_Filter := Next_Filter;
 247       end loop;
 248
 249       Descriptor.Filters := null;
 250
 251       --  Check process id (see comment in Send_Signal)
 252
 253       if Descriptor.Pid > 0 then
 254          Status := Waitpid (Descriptor.Pid);
 255       else
 256          raise Invalid_Process;
 257       end if;
 258    end Close;
 259
 260    procedure Close (Descriptor : in out Process_Descriptor) is
 261       Status : Integer;
 262       pragma Unreferenced (Status);
 263    begin
 264       Close (Descriptor, Status);
 265    end Close;
 266
 267    ------------
 268    -- Expect --
 269    ------------
 270
 271    procedure Expect
 272      (Descriptor  : in out Process_Descriptor;
 273       Result      : out Expect_Match;
 274       Regexp      : String;
 275       Timeout     : Integer := 10_000;
 276       Full_Buffer : Boolean := False)
 277    is
 278    begin
 279       if Regexp = "" then
 280          Expect (Descriptor, Result, Never_Match, Timeout, Full_Buffer);
 281       else
 282          Expect (Descriptor, Result, Compile (Regexp), Timeout, Full_Buffer);
 283       end if;
 284    end Expect;
 285
 286    procedure Expect
 287      (Descriptor  : in out Process_Descriptor;
 288       Result      : out Expect_Match;
 289       Regexp      : String;
 290       Matched     : out GNAT.Regpat.Match_Array;
 291       Timeout     : Integer := 10_000;
 292       Full_Buffer : Boolean := False)
 293    is
 294    begin
 295       pragma Assert (Matched'First = 0);
 296       if Regexp = "" then
 297          Expect
 298            (Descriptor, Result, Never_Match, Matched, Timeout, Full_Buffer);
 299       else
 300          Expect
 301            (Descriptor, Result, Compile (Regexp), Matched, Timeout,
 302             Full_Buffer);
 303       end if;
 304    end Expect;
 305
 306    procedure Expect
 307      (Descriptor  : in out Process_Descriptor;
 308       Result      : out Expect_Match;
 309       Regexp      : GNAT.Regpat.Pattern_Matcher;
 310       Timeout     : Integer := 10_000;
 311       Full_Buffer : Boolean := False)
 312    is
 313       Matched : GNAT.Regpat.Match_Array (0 .. 0);
 314       pragma Warnings (Off, Matched);
 315    begin
 316       Expect (Descriptor, Result, Regexp, Matched, Timeout, Full_Buffer);
 317    end Expect;
 318
 319    procedure Expect
 320      (Descriptor  : in out Process_Descriptor;
 321       Result      : out Expect_Match;
 322       Regexp      : GNAT.Regpat.Pattern_Matcher;
 323       Matched     : out GNAT.Regpat.Match_Array;
 324       Timeout     : Integer := 10_000;
 325       Full_Buffer : Boolean := False)
 326    is
 327       N           : Expect_Match;
 328       Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
 329       Try_Until   : constant Time := Clock + Duration (Timeout) / 1000.0;
 330       Timeout_Tmp : Integer := Timeout;
 331
 332    begin
 333       pragma Assert (Matched'First = 0);
 334       Reinitialize_Buffer (Descriptor);
 335
 336       loop
 337          --  First, test if what is already in the buffer matches (This is
 338          --  required if this package is used in multi-task mode, since one of
 339          --  the tasks might have added something in the buffer, and we don't
 340          --  want other tasks to wait for new input to be available before
 341          --  checking the regexps).
 342
 343          Match
 344            (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
 345
 346          if Descriptor.Buffer_Index >= 1 and then Matched (0).First /= 0 then
 347             Result := 1;
 348             Descriptor.Last_Match_Start := Matched (0).First;
 349             Descriptor.Last_Match_End := Matched (0).Last;
 350             return;
 351          end if;
 352
 353          --  Else try to read new input
 354
 355          Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer);
 356
 357          case N is
 358             when Expect_Internal_Error | Expect_Process_Died =>
 359                raise Process_Died;
 360
 361             when Expect_Timeout | Expect_Full_Buffer =>
 362                Result := N;
 363                return;
 364
 365             when others =>
 366                null;  --  See below
 367          end case;
 368
 369          --  Calculate the timeout for the next turn
 370
 371          --  Note that Timeout is, from the caller's perspective, the maximum
 372          --  time until a match, not the maximum time until some output is
 373          --  read, and thus cannot be reused as is for Expect_Internal.
 374
 375          if Timeout /= -1 then
 376             Timeout_Tmp := Integer (Try_Until - Clock) * 1000;
 377
 378             if Timeout_Tmp < 0 then
 379                Result := Expect_Timeout;
 380                exit;
 381             end if;
 382          end if;
 383       end loop;
 384
 385       --  Even if we had the general timeout above, we have to test that the
 386       --  last test we read from the external process didn't match.
 387
 388       Match
 389         (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
 390
 391       if Matched (0).First /= 0 then
 392          Result := 1;
 393          Descriptor.Last_Match_Start := Matched (0).First;
 394          Descriptor.Last_Match_End := Matched (0).Last;
 395          return;
 396       end if;
 397    end Expect;
 398
 399    procedure Expect
 400      (Descriptor  : in out Process_Descriptor;
 401       Result      : out Expect_Match;
 402       Regexps     : Regexp_Array;
 403       Timeout     : Integer := 10_000;
 404       Full_Buffer : Boolean := False)
 405    is
 406       Patterns : Compiled_Regexp_Array (Regexps'Range);
 407
 408       Matched : GNAT.Regpat.Match_Array (0 .. 0);
 409       pragma Warnings (Off, Matched);
 410
 411    begin
 412       for J in Regexps'Range loop
 413          Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
 414       end loop;
 415
 416       Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
 417
 418       for J in Regexps'Range loop
 419          Free (Patterns (J));
 420       end loop;
 421    end Expect;
 422
 423    procedure Expect
 424      (Descriptor  : in out Process_Descriptor;
 425       Result      : out Expect_Match;
 426       Regexps     : Compiled_Regexp_Array;
 427       Timeout     : Integer := 10_000;
 428       Full_Buffer : Boolean := False)
 429    is
 430       Matched : GNAT.Regpat.Match_Array (0 .. 0);
 431       pragma Warnings (Off, Matched);
 432    begin
 433       Expect (Descriptor, Result, Regexps, Matched, Timeout, Full_Buffer);
 434    end Expect;
 435
 436    procedure Expect
 437      (Result      : out Expect_Match;
 438       Regexps     : Multiprocess_Regexp_Array;
 439       Timeout     : Integer := 10_000;
 440       Full_Buffer : Boolean := False)
 441    is
 442       Matched : GNAT.Regpat.Match_Array (0 .. 0);
 443       pragma Warnings (Off, Matched);
 444    begin
 445       Expect (Result, Regexps, Matched, Timeout, Full_Buffer);
 446    end Expect;
 447
 448    procedure Expect
 449      (Descriptor  : in out Process_Descriptor;
 450       Result      : out Expect_Match;
 451       Regexps     : Regexp_Array;
 452       Matched     : out GNAT.Regpat.Match_Array;
 453       Timeout     : Integer := 10_000;
 454       Full_Buffer : Boolean := False)
 455    is
 456       Patterns : Compiled_Regexp_Array (Regexps'Range);
 457
 458    begin
 459       pragma Assert (Matched'First = 0);
 460
 461       for J in Regexps'Range loop
 462          Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
 463       end loop;
 464
 465       Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
 466
 467       for J in Regexps'Range loop
 468          Free (Patterns (J));
 469       end loop;
 470    end Expect;
 471
 472    procedure Expect
 473      (Descriptor  : in out Process_Descriptor;
 474       Result      : out Expect_Match;
 475       Regexps     : Compiled_Regexp_Array;
 476       Matched     : out GNAT.Regpat.Match_Array;
 477       Timeout     : Integer := 10_000;
 478       Full_Buffer : Boolean := False)
 479    is
 480       N           : Expect_Match;
 481       Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
 482
 483    begin
 484       pragma Assert (Matched'First = 0);
 485
 486       Reinitialize_Buffer (Descriptor);
 487
 488       loop
 489          --  First, test if what is already in the buffer matches (This is
 490          --  required if this package is used in multi-task mode, since one of
 491          --  the tasks might have added something in the buffer, and we don't
 492          --  want other tasks to wait for new input to be available before
 493          --  checking the regexps).
 494
 495          if Descriptor.Buffer /= null then
 496             for J in Regexps'Range loop
 497                Match
 498                  (Regexps (J).all,
 499                   Descriptor.Buffer (1 .. Descriptor.Buffer_Index),
 500                   Matched);
 501
 502                if Matched (0) /= No_Match then
 503                   Result := Expect_Match (J);
 504                   Descriptor.Last_Match_Start := Matched (0).First;
 505                   Descriptor.Last_Match_End := Matched (0).Last;
 506                   return;
 507                end if;
 508             end loop;
 509          end if;
 510
 511          Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
 512
 513          case N is
 514             when Expect_Internal_Error | Expect_Process_Died =>
 515                raise Process_Died;
 516
 517             when Expect_Timeout | Expect_Full_Buffer =>
 518                Result := N;
 519                return;
 520
 521             when others =>
 522                null;  --  Continue
 523          end case;
 524       end loop;
 525    end Expect;
 526
 527    procedure Expect
 528      (Result      : out Expect_Match;
 529       Regexps     : Multiprocess_Regexp_Array;
 530       Matched     : out GNAT.Regpat.Match_Array;
 531       Timeout     : Integer := 10_000;
 532       Full_Buffer : Boolean := False)
 533    is
 534       N           : Expect_Match;
 535       Descriptors : Array_Of_Pd (Regexps'Range);
 536
 537    begin
 538       pragma Assert (Matched'First = 0);
 539
 540       for J in Descriptors'Range loop
 541          Descriptors (J) := Regexps (J).Descriptor;
 542
 543          if Descriptors (J) /= null then
 544             Reinitialize_Buffer (Regexps (J).Descriptor.all);
 545          end if;
 546       end loop;
 547
 548       loop
 549          --  First, test if what is already in the buffer matches (This is
 550          --  required if this package is used in multi-task mode, since one of
 551          --  the tasks might have added something in the buffer, and we don't
 552          --  want other tasks to wait for new input to be available before
 553          --  checking the regexps).
 554
 555          for J in Regexps'Range loop
 556             if Regexps (J).Regexp /= null
 557                and then Regexps (J).Descriptor /= null
 558             then
 559                Match (Regexps (J).Regexp.all,
 560                       Regexps (J).Descriptor.Buffer
 561                         (1 .. Regexps (J).Descriptor.Buffer_Index),
 562                       Matched);
 563
 564                if Matched (0) /= No_Match then
 565                   Result := Expect_Match (J);
 566                   Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
 567                   Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
 568                   return;
 569                end if;
 570             end if;
 571          end loop;
 572
 573          Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
 574
 575          case N is
 576             when Expect_Internal_Error | Expect_Process_Died =>
 577                raise Process_Died;
 578
 579             when Expect_Timeout | Expect_Full_Buffer =>
 580                Result := N;
 581                return;
 582
 583             when others =>
 584                null;  --  Continue
 585          end case;
 586       end loop;
 587    end Expect;
 588
 589    ---------------------
 590    -- Expect_Internal --
 591    ---------------------
 592
 593    procedure Expect_Internal
 594      (Descriptors : in out Array_Of_Pd;
 595       Result      : out Expect_Match;
 596       Timeout     : Integer;
 597       Full_Buffer : Boolean)
 598    is
 599       Num_Descriptors : Integer;
 600       Buffer_Size     : Integer := 0;
 601
 602       N : Integer;
 603
 604       type File_Descriptor_Array is
 605         array (0 .. Descriptors'Length - 1) of File_Descriptor;
 606       Fds : aliased File_Descriptor_Array;
 607       Fds_Count : Natural := 0;
 608
 609       Fds_To_Descriptor : array (Fds'Range) of Integer;
 610       --  Maps file descriptor entries from Fds to entries in Descriptors.
 611       --  They do not have the same index when entries in Descriptors are null.
 612
 613       type Integer_Array is array (Fds'Range) of Integer;
 614       Is_Set : aliased Integer_Array;
 615
 616    begin
 617       for J in Descriptors'Range loop
 618          if Descriptors (J) /= null then
 619             Fds (Fds'First + Fds_Count) := Descriptors (J).Output_Fd;
 620             Fds_To_Descriptor (Fds'First + Fds_Count) := J;
 621             Fds_Count := Fds_Count + 1;
 622
 623             if Descriptors (J).Buffer_Size = 0 then
 624                Buffer_Size := Integer'Max (Buffer_Size, 4096);
 625             else
 626                Buffer_Size :=
 627                  Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
 628             end if;
 629          end if;
 630       end loop;
 631
 632       declare
 633          Buffer : aliased String (1 .. Buffer_Size);
 634          --  Buffer used for input. This is allocated only once, not for
 635          --  every iteration of the loop
 636
 637          D : Integer;
 638          --  Index in Descriptors
 639
 640       begin
 641          --  Loop until we match or we have a timeout
 642
 643          loop
 644             Num_Descriptors :=
 645               Poll (Fds'Address, Fds_Count, Timeout, Is_Set'Address);
 646
 647             case Num_Descriptors is
 648
 649                --  Error?
 650
 651                when -1 =>
 652                   Result := Expect_Internal_Error;
 653                   return;
 654
 655                --  Timeout?
 656
 657                when 0  =>
 658                   Result := Expect_Timeout;
 659                   return;
 660
 661                --  Some input
 662
 663                when others =>
 664                   for F in Fds'Range loop
 665                      if Is_Set (F) = 1 then
 666                         D := Fds_To_Descriptor (F);
 667
 668                         Buffer_Size := Descriptors (D).Buffer_Size;
 669
 670                         if Buffer_Size = 0 then
 671                            Buffer_Size := 4096;
 672                         end if;
 673
 674                         N := Read (Descriptors (D).Output_Fd, Buffer'Address,
 675                                    Buffer_Size);
 676
 677                         --  Error or End of file
 678
 679                         if N <= 0 then
 680                            --  ??? Note that ddd tries again up to three times
 681                            --  in that case. See LiterateA.C:174
 682
 683                            Descriptors (D).Input_Fd := Invalid_FD;
 684                            Result := Expect_Process_Died;
 685                            return;
 686
 687                         else
 688                            --  If there is no limit to the buffer size
 689
 690                            if Descriptors (D).Buffer_Size = 0 then
 691
 692                               declare
 693                                  Tmp : String_Access := Descriptors (D).Buffer;
 694
 695                               begin
 696                                  if Tmp /= null then
 697                                     Descriptors (D).Buffer :=
 698                                       new String (1 .. Tmp'Length + N);
 699                                     Descriptors (D).Buffer (1 .. Tmp'Length) :=
 700                                       Tmp.all;
 701                                     Descriptors (D).Buffer
 702                                       (Tmp'Length + 1 .. Tmp'Length + N) :=
 703                                       Buffer (1 .. N);
 704                                     Free (Tmp);
 705                                     Descriptors (D).Buffer_Index :=
 706                                       Descriptors (D).Buffer'Last;
 707
 708                                  else
 709                                     Descriptors (D).Buffer :=
 710                                       new String (1 .. N);
 711                                     Descriptors (D).Buffer.all :=
 712                                       Buffer (1 .. N);
 713                                     Descriptors (D).Buffer_Index := N;
 714                                  end if;
 715                               end;
 716
 717                            else
 718                               --  Add what we read to the buffer
 719
 720                               if Descriptors (D).Buffer_Index + N >
 721                                 Descriptors (D).Buffer_Size
 722                               then
 723                                  --  If the user wants to know when we have
 724                                  --  read more than the buffer can contain.
 725
 726                                  if Full_Buffer then
 727                                     Result := Expect_Full_Buffer;
 728                                     return;
 729                                  end if;
 730
 731                                  --  Keep as much as possible from the buffer,
 732                                  --  and forget old characters.
 733
 734                                  Descriptors (D).Buffer
 735                                    (1 .. Descriptors (D).Buffer_Size - N) :=
 736                                   Descriptors (D).Buffer
 737                                    (N - Descriptors (D).Buffer_Size +
 738                                     Descriptors (D).Buffer_Index + 1 ..
 739                                     Descriptors (D).Buffer_Index);
 740                                  Descriptors (D).Buffer_Index :=
 741                                    Descriptors (D).Buffer_Size - N;
 742                               end if;
 743
 744                               --  Keep what we read in the buffer
 745
 746                               Descriptors (D).Buffer
 747                                 (Descriptors (D).Buffer_Index + 1 ..
 748                                  Descriptors (D).Buffer_Index + N) :=
 749                                 Buffer (1 .. N);
 750                               Descriptors (D).Buffer_Index :=
 751                                 Descriptors (D).Buffer_Index + N;
 752                            end if;
 753
 754                            --  Call each of the output filter with what we
 755                            --  read.
 756
 757                            Call_Filters
 758                              (Descriptors (D).all, Buffer (1 .. N), Output);
 759
 760                            Result := Expect_Match (D);
 761                            return;
 762                         end if;
 763                      end if;
 764                   end loop;
 765             end case;
 766          end loop;
 767       end;
 768    end Expect_Internal;
 769
 770    ----------------
 771    -- Expect_Out --
 772    ----------------
 773
 774    function Expect_Out (Descriptor : Process_Descriptor) return String is
 775    begin
 776       return Descriptor.Buffer (1 .. Descriptor.Last_Match_End);
 777    end Expect_Out;
 778
 779    ----------------------
 780    -- Expect_Out_Match --
 781    ----------------------
 782
 783    function Expect_Out_Match (Descriptor : Process_Descriptor) return String is
 784    begin
 785       return Descriptor.Buffer
 786         (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
 787    end Expect_Out_Match;
 788
 789    ------------------------
 790    -- First_Dead_Process --
 791    ------------------------
 792
 793    function First_Dead_Process
 794      (Regexp : Multiprocess_Regexp_Array) return Natural is
 795    begin
 796       for R in Regexp'Range loop
 797          if Regexp (R).Descriptor /= null
 798            and then Regexp (R).Descriptor.Input_Fd = GNAT.OS_Lib.Invalid_FD
 799          then
 800             return R;
 801          end if;
 802       end loop;
 803
 804       return 0;
 805    end First_Dead_Process;
 806
 807    -----------
 808    -- Flush --
 809    -----------
 810
 811    procedure Flush
 812      (Descriptor : in out Process_Descriptor;
 813       Timeout    : Integer := 0)
 814    is
 815       Buffer_Size     : constant Integer := 8192;
 816       Num_Descriptors : Integer;
 817       N               : Integer;
 818       Is_Set          : aliased Integer;
 819       Buffer          : aliased String (1 .. Buffer_Size);
 820
 821    begin
 822       --  Empty the current buffer
 823
 824       Descriptor.Last_Match_End := Descriptor.Buffer_Index;
 825       Reinitialize_Buffer (Descriptor);
 826
 827       --  Read everything from the process to flush its output
 828
 829       loop
 830          Num_Descriptors :=
 831            Poll (Descriptor.Output_Fd'Address, 1, Timeout, Is_Set'Address);
 832
 833          case Num_Descriptors is
 834
 835             --  Error ?
 836
 837             when -1 =>
 838                raise Process_Died;
 839
 840             --  Timeout => End of flush
 841
 842             when 0  =>
 843                return;
 844
 845             --  Some input
 846
 847             when others =>
 848                if Is_Set = 1 then
 849                   N := Read (Descriptor.Output_Fd, Buffer'Address,
 850                              Buffer_Size);
 851
 852                   if N = -1 then
 853                      raise Process_Died;
 854                   elsif N = 0 then
 855                      return;
 856                   end if;
 857                end if;
 858          end case;
 859       end loop;
 860    end Flush;
 861
 862    ----------
 863    -- Free --
 864    ----------
 865
 866    procedure Free (Regexp : in out Multiprocess_Regexp) is
 867       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 868         (Process_Descriptor'Class, Process_Descriptor_Access);
 869    begin
 870       Unchecked_Free (Regexp.Descriptor);
 871       Free (Regexp.Regexp);
 872    end Free;
 873
 874    ------------------------
 875    -- Get_Command_Output --
 876    ------------------------
 877
 878    function Get_Command_Output
 879      (Command    : String;
 880       Arguments  : GNAT.OS_Lib.Argument_List;
 881       Input      : String;
 882       Status     : not null access Integer;
 883       Err_To_Out : Boolean := False) return String
 884    is
 885       use GNAT.Expect;
 886
 887       Process : Process_Descriptor;
 888
 889       Output : String_Access := new String (1 .. 1024);
 890       --  Buffer used to accumulate standard output from the launched
 891       --  command, expanded as necessary during execution.
 892
 893       Last : Integer := 0;
 894       --  Index of the last used character within Output
 895
 896    begin
 897       Non_Blocking_Spawn
 898         (Process, Command, Arguments, Err_To_Out => Err_To_Out);
 899
 900       if Input'Length > 0 then
 901          Send (Process, Input);
 902       end if;
 903
 904       Close (Process.Input_Fd);
 905       Process.Input_Fd := Invalid_FD;
 906
 907       declare
 908          Result : Expect_Match;
 909          pragma Unreferenced (Result);
 910
 911       begin
 912          --  This loop runs until the call to Expect raises Process_Died
 913
 914          loop
 915             Expect (Process, Result, ".+");
 916
 917             declare
 918                NOutput : String_Access;
 919                S       : constant String := Expect_Out (Process);
 920                pragma Assert (S'Length > 0);
 921
 922             begin
 923                --  Expand buffer if we need more space. Note here that we add
 924                --  S'Length to ensure that S will fit in the new buffer size.
 925
 926                if Last + S'Length > Output'Last then
 927                   NOutput := new String (1 .. 2 * Output'Last + S'Length);
 928                   NOutput (Output'Range) := Output.all;
 929                   Free (Output);
 930
 931                   --  Here if current buffer size is OK
 932
 933                else
 934                   NOutput := Output;
 935                end if;
 936
 937                NOutput (Last + 1 .. Last + S'Length) := S;
 938                Last := Last + S'Length;
 939                Output := NOutput;
 940             end;
 941          end loop;
 942
 943       exception
 944          when Process_Died =>
 945             Close (Process, Status.all);
 946       end;
 947
 948       if Last = 0 then
 949          return "";
 950       end if;
 951
 952       declare
 953          S : constant String := Output (1 .. Last);
 954       begin
 955          Free (Output);
 956          return S;
 957       end;
 958    end Get_Command_Output;
 959
 960    ------------------
 961    -- Get_Error_Fd --
 962    ------------------
 963
 964    function Get_Error_Fd
 965      (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
 966    is
 967    begin
 968       return Descriptor.Error_Fd;
 969    end Get_Error_Fd;
 970
 971    ------------------
 972    -- Get_Input_Fd --
 973    ------------------
 974
 975    function Get_Input_Fd
 976      (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
 977    is
 978    begin
 979       return Descriptor.Input_Fd;
 980    end Get_Input_Fd;
 981
 982    -------------------
 983    -- Get_Output_Fd --
 984    -------------------
 985
 986    function Get_Output_Fd
 987      (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
 988    is
 989    begin
 990       return Descriptor.Output_Fd;
 991    end Get_Output_Fd;
 992
 993    -------------
 994    -- Get_Pid --
 995    -------------
 996
 997    function Get_Pid
 998      (Descriptor : Process_Descriptor) return Process_Id
 999    is
1000    begin
1001       return Descriptor.Pid;
1002    end Get_Pid;
1003
1004    -----------------
1005    -- Has_Process --
1006    -----------------
1007
1008    function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean is
1009    begin
1010       return Regexp /= (Regexp'Range => (null, null));
1011    end Has_Process;
1012
1013    ---------------
1014    -- Interrupt --
1015    ---------------
1016
1017    procedure Interrupt (Descriptor : in out Process_Descriptor) is
1018       SIGINT : constant := 2;
1019    begin
1020       Send_Signal (Descriptor, SIGINT);
1021    end Interrupt;
1022
1023    ------------------
1024    -- Lock_Filters --
1025    ------------------
1026
1027    procedure Lock_Filters (Descriptor : in out Process_Descriptor) is
1028    begin
1029       Descriptor.Filters_Lock := Descriptor.Filters_Lock + 1;
1030    end Lock_Filters;
1031
1032    ------------------------
1033    -- Non_Blocking_Spawn --
1034    ------------------------
1035
1036    procedure Non_Blocking_Spawn
1037      (Descriptor  : out Process_Descriptor'Class;
1038       Command     : String;
1039       Args        : GNAT.OS_Lib.Argument_List;
1040       Buffer_Size : Natural := 4096;
1041       Err_To_Out  : Boolean := False)
1042    is
1043       function Fork return Process_Id;
1044       pragma Import (C, Fork, "__gnat_expect_fork");
1045       --  Starts a new process if possible. See the Unix command fork for more
1046       --  information. On systems that do not support this capability (such as
1047       --  Windows...), this command does nothing, and Fork will return
1048       --  Null_Pid.
1049
1050       Pipe1, Pipe2, Pipe3 : aliased Pipe_Type;
1051
1052       Arg        : String_Access;
1053       Arg_List   : String_List (1 .. Args'Length + 2);
1054       C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address;
1055
1056       Command_With_Path : String_Access;
1057
1058    begin
1059       --  Create the rest of the pipes
1060
1061       Set_Up_Communications
1062         (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
1063
1064       Command_With_Path := Locate_Exec_On_Path (Command);
1065
1066       if Command_With_Path = null then
1067          raise Invalid_Process;
1068       end if;
1069
1070       --  Fork a new process
1071
1072       Descriptor.Pid := Fork;
1073
1074       --  Are we now in the child (or, for Windows, still in the common
1075       --  process).
1076
1077       if Descriptor.Pid = Null_Pid then
1078          --  Prepare an array of arguments to pass to C
1079
1080          Arg := new String (1 .. Command_With_Path'Length + 1);
1081          Arg (1 .. Command_With_Path'Length) := Command_With_Path.all;
1082          Arg (Arg'Last)        := ASCII.NUL;
1083          Arg_List (1)          := Arg;
1084
1085          for J in Args'Range loop
1086             Arg                     := new String (1 .. Args (J)'Length + 1);
1087             Arg (1 .. Args (J)'Length)    := Args (J).all;
1088             Arg (Arg'Last)                := ASCII.NUL;
1089             Arg_List (J + 2 - Args'First) := Arg.all'Access;
1090          end loop;
1091
1092          Arg_List (Arg_List'Last) := null;
1093
1094          --  Make sure all arguments are compatible with OS conventions
1095
1096          Normalize_Arguments (Arg_List);
1097
1098          --  Prepare low-level argument list from the normalized arguments
1099
1100          for K in Arg_List'Range loop
1101             C_Arg_List (K) :=
1102               (if Arg_List (K) /= null
1103                then Arg_List (K).all'Address
1104                else System.Null_Address);
1105          end loop;
1106
1107          --  This does not return on Unix systems
1108
1109          Set_Up_Child_Communications
1110            (Descriptor, Pipe1, Pipe2, Pipe3, Command_With_Path.all,
1111             C_Arg_List'Address);
1112       end if;
1113
1114       Free (Command_With_Path);
1115
1116       --  Did we have an error when spawning the child ?
1117
1118       if Descriptor.Pid < Null_Pid then
1119          raise Invalid_Process;
1120       else
1121          --  We are now in the parent process
1122
1123          Set_Up_Parent_Communications (Descriptor, Pipe1, Pipe2, Pipe3);
1124       end if;
1125
1126       --  Create the buffer
1127
1128       Descriptor.Buffer_Size := Buffer_Size;
1129
1130       if Buffer_Size /= 0 then
1131          Descriptor.Buffer := new String (1 .. Positive (Buffer_Size));
1132       end if;
1133
1134       --  Initialize the filters
1135
1136       Descriptor.Filters := null;
1137    end Non_Blocking_Spawn;
1138
1139    -------------------------
1140    -- Reinitialize_Buffer --
1141    -------------------------
1142
1143    procedure Reinitialize_Buffer
1144      (Descriptor : in out Process_Descriptor'Class)
1145    is
1146    begin
1147       if Descriptor.Buffer_Size = 0 then
1148          declare
1149             Tmp : String_Access := Descriptor.Buffer;
1150
1151          begin
1152             Descriptor.Buffer :=
1153               new String
1154                 (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End);
1155
1156             if Tmp /= null then
1157                Descriptor.Buffer.all := Tmp
1158                  (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
1159                Free (Tmp);
1160             end if;
1161          end;
1162
1163          Descriptor.Buffer_Index := Descriptor.Buffer'Last;
1164
1165       else
1166          Descriptor.Buffer
1167            (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End) :=
1168              Descriptor.Buffer
1169                (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
1170
1171          if Descriptor.Buffer_Index > Descriptor.Last_Match_End then
1172             Descriptor.Buffer_Index :=
1173               Descriptor.Buffer_Index - Descriptor.Last_Match_End;
1174          else
1175             Descriptor.Buffer_Index := 0;
1176          end if;
1177       end if;
1178
1179       Descriptor.Last_Match_Start := 0;
1180       Descriptor.Last_Match_End := 0;
1181    end Reinitialize_Buffer;
1182
1183    -------------------
1184    -- Remove_Filter --
1185    -------------------
1186
1187    procedure Remove_Filter
1188      (Descriptor : in out Process_Descriptor;
1189       Filter     : Filter_Function)
1190    is
1191       Previous : Filter_List := null;
1192       Current  : Filter_List := Descriptor.Filters;
1193
1194    begin
1195       while Current /= null loop
1196          if Current.Filter = Filter then
1197             if Previous = null then
1198                Descriptor.Filters := Current.Next;
1199             else
1200                Previous.Next := Current.Next;
1201             end if;
1202          end if;
1203
1204          Previous := Current;
1205          Current := Current.Next;
1206       end loop;
1207    end Remove_Filter;
1208
1209    ----------
1210    -- Send --
1211    ----------
1212
1213    procedure Send
1214      (Descriptor   : in out Process_Descriptor;
1215       Str          : String;
1216       Add_LF       : Boolean := True;
1217       Empty_Buffer : Boolean := False)
1218    is
1219       Line_Feed   : aliased constant String := (1 .. 1 => ASCII.LF);
1220       Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
1221
1222       Result  : Expect_Match;
1223       Discard : Natural;
1224       pragma Warnings (Off, Result);
1225       pragma Warnings (Off, Discard);
1226
1227    begin
1228       if Empty_Buffer then
1229
1230          --  Force a read on the process if there is anything waiting
1231
1232          Expect_Internal
1233            (Descriptors, Result, Timeout => 0, Full_Buffer => False);
1234
1235          if Result = Expect_Internal_Error
1236            or else Result = Expect_Process_Died
1237          then
1238             raise Process_Died;
1239          end if;
1240
1241          Descriptor.Last_Match_End := Descriptor.Buffer_Index;
1242
1243          --  Empty the buffer
1244
1245          Reinitialize_Buffer (Descriptor);
1246       end if;
1247
1248       Call_Filters (Descriptor, Str, Input);
1249       Discard :=
1250         Write (Descriptor.Input_Fd, Str'Address, Str'Last - Str'First + 1);
1251
1252       if Add_LF then
1253          Call_Filters (Descriptor, Line_Feed, Input);
1254          Discard :=
1255            Write (Descriptor.Input_Fd, Line_Feed'Address, 1);
1256       end if;
1257    end Send;
1258
1259    -----------------
1260    -- Send_Signal --
1261    -----------------
1262
1263    procedure Send_Signal
1264      (Descriptor : Process_Descriptor;
1265       Signal     : Integer)
1266    is
1267    begin
1268       --  A nonpositive process id passed to kill has special meanings. For
1269       --  example, -1 means kill all processes in sight, including self, in
1270       --  POSIX and Windows (and something slightly different in Linux). See
1271       --  man pages for details. In any case, we don't want to do that. Note
1272       --  that Descriptor.Pid will be -1 if the process was not successfully
1273       --  started; we don't want to kill ourself in that case.
1274
1275       if Descriptor.Pid > 0 then
1276          Kill (Descriptor.Pid, Signal, Close => 1);
1277          --  ??? Need to check process status here
1278       else
1279          raise Invalid_Process;
1280       end if;
1281    end Send_Signal;
1282
1283    ---------------------------------
1284    -- Set_Up_Child_Communications --
1285    ---------------------------------
1286
1287    procedure Set_Up_Child_Communications
1288      (Pid   : in out Process_Descriptor;
1289       Pipe1 : in out Pipe_Type;
1290       Pipe2 : in out Pipe_Type;
1291       Pipe3 : in out Pipe_Type;
1292       Cmd   : String;
1293       Args  : System.Address)
1294    is
1295       pragma Warnings (Off, Pid);
1296       pragma Warnings (Off, Pipe1);
1297       pragma Warnings (Off, Pipe2);
1298       pragma Warnings (Off, Pipe3);
1299
1300       Input  : File_Descriptor;
1301       Output : File_Descriptor;
1302       Error  : File_Descriptor;
1303
1304       No_Fork_On_Target : constant Boolean := Target_OS = Windows;
1305
1306    begin
1307       if No_Fork_On_Target then
1308
1309          --  Since Windows does not have a separate fork/exec, we need to
1310          --  perform the following actions:
1311
1312          --    - save stdin, stdout, stderr
1313          --    - replace them by our pipes
1314          --    - create the child with process handle inheritance
1315          --    - revert to the previous stdin, stdout and stderr.
1316
1317          Input  := Dup (GNAT.OS_Lib.Standin);
1318          Output := Dup (GNAT.OS_Lib.Standout);
1319          Error  := Dup (GNAT.OS_Lib.Standerr);
1320       end if;
1321
1322       --  Since we are still called from the parent process, there is no way
1323       --  currently we can cleanly close the unneeded ends of the pipes, but
1324       --  this doesn't really matter.
1325
1326       --  We could close Pipe1.Output, Pipe2.Input, Pipe3.Input
1327
1328       Dup2 (Pipe1.Input,  GNAT.OS_Lib.Standin);
1329       Dup2 (Pipe2.Output, GNAT.OS_Lib.Standout);
1330       Dup2 (Pipe3.Output, GNAT.OS_Lib.Standerr);
1331
1332       Portable_Execvp (Pid.Pid'Access, Cmd & ASCII.NUL, Args);
1333
1334       --  The following commands are not executed on Unix systems, and are only
1335       --  required for Windows systems. We are now in the parent process.
1336
1337       --  Restore the old descriptors
1338
1339       Dup2 (Input,  GNAT.OS_Lib.Standin);
1340       Dup2 (Output, GNAT.OS_Lib.Standout);
1341       Dup2 (Error,  GNAT.OS_Lib.Standerr);
1342       Close (Input);
1343       Close (Output);
1344       Close (Error);
1345    end Set_Up_Child_Communications;
1346
1347    ---------------------------
1348    -- Set_Up_Communications --
1349    ---------------------------
1350
1351    procedure Set_Up_Communications
1352      (Pid        : in out Process_Descriptor;
1353       Err_To_Out : Boolean;
1354       Pipe1      : not null access Pipe_Type;
1355       Pipe2      : not null access Pipe_Type;
1356       Pipe3      : not null access Pipe_Type)
1357    is
1358       Status : Boolean;
1359       pragma Unreferenced (Status);
1360
1361    begin
1362       --  Create the pipes
1363
1364       if Create_Pipe (Pipe1) /= 0 then
1365          return;
1366       end if;
1367
1368       if Create_Pipe (Pipe2) /= 0 then
1369          return;
1370       end if;
1371
1372       --  Record the 'parent' end of the two pipes in Pid:
1373       --    Child stdin  is connected to the 'write' end of Pipe1;
1374       --    Child stdout is connected to the 'read'  end of Pipe2.
1375       --  We do not want these descriptors to remain open in the child
1376       --  process, so we mark them close-on-exec/non-inheritable.
1377
1378       Pid.Input_Fd  := Pipe1.Output;
1379       Set_Close_On_Exec (Pipe1.Output, True, Status);
1380       Pid.Output_Fd := Pipe2.Input;
1381       Set_Close_On_Exec (Pipe2.Input, True, Status);
1382
1383       if Err_To_Out then
1384
1385          --  Reuse the standard output pipe for standard error
1386
1387          Pipe3.all := Pipe2.all;
1388
1389       else
1390          --  Create a separate pipe for standard error
1391
1392          if Create_Pipe (Pipe3) /= 0 then
1393             return;
1394          end if;
1395       end if;
1396
1397       --  As above, record the proper fd for the child's standard error stream
1398
1399       Pid.Error_Fd := Pipe3.Input;
1400       Set_Close_On_Exec (Pipe3.Input, True, Status);
1401    end Set_Up_Communications;
1402
1403    ----------------------------------
1404    -- Set_Up_Parent_Communications --
1405    ----------------------------------
1406
1407    procedure Set_Up_Parent_Communications
1408      (Pid   : in out Process_Descriptor;
1409       Pipe1 : in out Pipe_Type;
1410       Pipe2 : in out Pipe_Type;
1411       Pipe3 : in out Pipe_Type)
1412    is
1413       pragma Warnings (Off, Pid);
1414       pragma Warnings (Off, Pipe1);
1415       pragma Warnings (Off, Pipe2);
1416       pragma Warnings (Off, Pipe3);
1417
1418    begin
1419       Close (Pipe1.Input);
1420       Close (Pipe2.Output);
1421
1422       if Pipe3.Output /= Pipe2.Output then
1423          Close (Pipe3.Output);
1424       end if;
1425    end Set_Up_Parent_Communications;
1426
1427    ------------------
1428    -- Trace_Filter --
1429    ------------------
1430
1431    procedure Trace_Filter
1432      (Descriptor : Process_Descriptor'Class;
1433       Str        : String;
1434       User_Data  : System.Address := System.Null_Address)
1435    is
1436       pragma Warnings (Off, Descriptor);
1437       pragma Warnings (Off, User_Data);
1438    begin
1439       GNAT.IO.Put (Str);
1440    end Trace_Filter;
1441
1442    --------------------
1443    -- Unlock_Filters --
1444    --------------------
1445
1446    procedure Unlock_Filters (Descriptor : in out Process_Descriptor) is
1447    begin
1448       if Descriptor.Filters_Lock > 0 then
1449          Descriptor.Filters_Lock := Descriptor.Filters_Lock - 1;
1450       end if;
1451    end Unlock_Filters;
1452
1453 end GNAT.Expect;