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