1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137 | --
-- Copyright (C) 2018-2021, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
--
-- This is a test to check calls in unexpected order, such as
-- * write to standard input while process has not been started
-- * write to standard input while process has not finished
--
-- To be portable this test launch itself with "-slave" option.
with Ada.Command_Line;
with Ada.Directories;
with Ada.Streams;
with Ada.Text_IO;
with Spawn.Processes;
with Spawn.Processes.Monitor_Loop;
with Spawn.String_Vectors;
procedure Spawn_Unexpected is
procedure Write_Standard_Input
(Process : in out Spawn.Processes.Process;
Sample : Character);
-- Write some data to Process's Standard_Input.
package Listeners is
type Listener is limited new Spawn.Processes.Process_Listener with record
P : Spawn.Processes.Process;
Stopped : Boolean := False;
end record;
overriding procedure Standard_Input_Available
(Self : in out Listener);
-- Called once when it's possible to write data again.
overriding procedure Started (Self : in out Listener);
overriding procedure Finished
(Self : in out Listener;
Exit_Status : Spawn.Processes.Process_Exit_Status;
Exit_Code : Spawn.Processes.Process_Exit_Code);
overriding procedure Error_Occurred
(Self : in out Listener;
Process_Error : Integer);
end Listeners;
package body Listeners is
overriding procedure Standard_Input_Available
(Self : in out Listener)
is
pragma Unreferenced (Self);
begin
Ada.Text_IO.Put_Line ("Standard_Input_Available");
end Standard_Input_Available;
overriding procedure Started (Self : in out Listener) is
pragma Unreferenced (Self);
begin
Ada.Text_IO.Put_Line ("Started");
end Started;
overriding procedure Finished
(Self : in out Listener;
Exit_Status : Spawn.Processes.Process_Exit_Status;
Exit_Code : Spawn.Processes.Process_Exit_Code) is
begin
Ada.Text_IO.Put_Line ("Finished" & (Exit_Code'Img));
Self.Stopped := True;
end Finished;
overriding procedure Error_Occurred
(Self : in out Listener;
Process_Error : Integer)
is
pragma Unreferenced (Self);
begin
Ada.Text_IO.Put_Line ("Error_Occurred:" & (Process_Error'Img));
Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
end Error_Occurred;
end Listeners;
--------------------------
-- Write_Standard_Input --
--------------------------
procedure Write_Standard_Input
(Process : in out Spawn.Processes.Process;
Sample : Character)
is
use type Ada.Streams.Stream_Element_Offset;
Chunk : constant Ada.Streams.Stream_Element_Array :=
(1 .. 10 => Character'Pos (Sample));
Last : Ada.Streams.Stream_Element_Offset;
begin
Process.Write_Standard_Input (Chunk, Last);
pragma Assert (Last < Chunk'First);
end Write_Standard_Input;
use all type Spawn.Processes.Process_Status;
Cmd : constant String :=
Ada.Directories.Full_Name (Ada.Command_Line.Command_Name);
Args : Spawn.String_Vectors.UTF_8_String_Vector;
L : aliased Listeners.Listener;
begin
if Ada.Command_Line.Argument_Count >= 1
and then Ada.Command_Line.Argument (1) = "-slave"
then
-- This is a subprocess, exit.
return;
end if;
Args.Append ("-slave");
L.P.Set_Program (Cmd);
L.P.Set_Arguments (Args);
L.P.Set_Working_Directory (Ada.Directories.Current_Directory);
L.P.Set_Listener (L'Unchecked_Access);
Write_Standard_Input (L.P, Sample => '1');
L.P.Start;
while not (L.Stopped and L.P.Status = Not_Running) loop
Spawn.Processes.Monitor_Loop (1);
end loop;
Write_Standard_Input (L.P, Sample => '2');
end Spawn_Unexpected;
|