summaryrefslogtreecommitdiff
path: root/testsuite/tests/lib-unix/common/redirections.ml
blob: b9c04a23230734aaf2e80dbee9362d9ee2b69592 (plain)
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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
(* TEST

readonly_files = "reflector.ml"
unset XVAR

* hasunix
** setup-ocamlc.byte-build-env
program = "${test_build_directory}/redirections.byte"
*** ocamlc.byte
program = "${test_build_directory}/reflector.exe"
all_modules = "reflector.ml"
**** ocamlc.byte
include unix
program = "${test_build_directory}/redirections.byte"
all_modules= "redirections.ml"
***** check-ocamlc.byte-output
****** run
******* check-program-output

** setup-ocamlopt.byte-build-env
program = "${test_build_directory}/redirections.opt"
*** ocamlopt.byte
program = "${test_build_directory}/reflector.exe"
all_modules = "reflector.ml"
**** ocamlopt.byte
include unix
program = "${test_build_directory}/redirections.opt"
all_modules= "redirections.ml"
***** check-ocamlopt.byte-output
****** run
******* check-program-output

*)


let cat file =
  let fd = Unix.openfile file [Unix.O_RDONLY] 0 in
  let buf = Bytes.create 1024 in
  let rec cat () =
    let n = Unix.read fd buf 0 (Bytes.length buf) in
    if n > 0 then (ignore(Unix.write Unix.stdout buf 0 n); cat ())
  in cat (); Unix.close fd

let out fd txt =
  ignore (Unix.write_substring fd txt 0 (String.length txt))

let refl =
  Filename.concat Filename.current_dir_name "reflector.exe"

let test_createprocess systemenv =
  let f_out =
    Unix.(openfile "./tmpout.txt" [O_WRONLY;O_TRUNC;O_CREAT;O_CLOEXEC] 0o600) in
  let f_err =
    Unix.(openfile "./tmperr.txt" [O_WRONLY;O_TRUNC;O_CREAT;O_CLOEXEC] 0o600) in
  let (p_exit, p_entrance) =
    Unix.pipe ~cloexec:true () in
  let pid =
    Unix.create_process_env
       refl
       [| refl; "-i2o"; "-i2e"; "-o"; "123"; "-e"; "456"; "-i2o"; "-v"; "XVAR"
       |]
       (Array.append [| "XVAR=xvar" |] systemenv)
       p_exit f_out f_err in
  out p_entrance "aaaa\n";
  out p_entrance "bbbb\n";
  Unix.close p_entrance;
  let (_, status) = Unix.waitpid [] pid in
  Unix.close p_exit; Unix.close f_out; Unix.close f_err;
  if status <> Unix.WEXITED 0 then
    out Unix.stdout "!!! reflector exited with an error\n";
  out Unix.stdout "---- File tmpout.txt\n";
  cat "./tmpout.txt";
  out Unix.stdout "---- File tmperr.txt\n";
  cat "./tmperr.txt";
  Sys.remove "./tmpout.txt";
  Sys.remove "./tmperr.txt"

let test_2ampsup1 () =    (* 2>&1 redirection, cf. GPR#1105 *)
  let pid =
    Unix.create_process
      refl
      [| refl; "-o"; "123"; "-e"; "456"; "-o"; "789" |]
      Unix.stdin Unix.stdout Unix.stdout in
  let (_, status) = Unix.waitpid [] pid in
  if status <> Unix.WEXITED 0 then
    out Unix.stdout "!!! reflector exited with an error\n"

let test_swap12 () =    (* swapping stdout and stderr *)
  (* The test harness doesn't let us check contents of stderr,
     so just output on stdout (after redirection) *)
  let pid =
    Unix.create_process
      refl
      [| refl; "-e"; "123" |]
      Unix.stdin Unix.stderr Unix.stdout in
  let (_, status) = Unix.waitpid [] pid in
  if status <> Unix.WEXITED 0 then
    out Unix.stdout "!!! reflector exited with an error\n"

let test_12tofile () =   (* > file 2>&1 *)
  let f =
    Unix.(openfile "./tmpout.txt" [O_WRONLY;O_TRUNC;O_CREAT;O_CLOEXEC] 0o600) in
  let pid =
    Unix.create_process
       refl
       [| refl; "-o"; "123"; "-e"; "456"; "-o"; "789" |]
       Unix.stdin f f in
  let (_, status) = Unix.waitpid [] pid in
  Unix.close f;
  if status <> Unix.WEXITED 0 then
    out Unix.stdout "!!! reflector exited with an error\n";
  out Unix.stdout "---- File tmpout.txt\n";
  cat "./tmpout.txt";
  Sys.remove "./tmpout.txt"

let test_open_process_in () =
  let ic = Unix.open_process_in (refl ^ " -o 123 -o 456") in
  out Unix.stdout (input_line ic ^ "\n");
  out Unix.stdout (input_line ic ^ "\n");
  let status = Unix.close_process_in ic in
  if status <> Unix.WEXITED 0 then
    out Unix.stdout "!!! reflector exited with an error\n"

let test_open_process_out () =
  let oc = Unix.open_process_out (refl ^ " -i2o -i2o -i2o") in
  output_string oc "aa\nbbbb\n"; close_out oc;
  let status = Unix.close_process_out oc in
  if status <> Unix.WEXITED 0 then
    out Unix.stdout "!!! reflector exited with an error\n"

let test_open_process_full systemenv =
  let ((o, i, e) as res) =
    Unix.open_process_full
      (refl ^ " -o 123 -i2o -e 456 -i2e -v XVAR")
      (Array.append [|"XVAR=xvar"|] systemenv) in
  output_string i "aa\nbbbb\n"; close_out i;
  for _i = 1 to 3 do
    out Unix.stdout (input_line o ^ "\n")
  done;
  for _i = 1 to 2 do
    out Unix.stdout (input_line e ^ "\n")
  done;
  let status = Unix.close_process_full res in
  if status <> Unix.WEXITED 0 then
    out Unix.stdout "!!! reflector exited with an error\n"

let _ =
  let env = Unix.environment() in
  (* The following 'close' makes things more difficult.
     Under Unix it works fine, but under Win32 create_process
     gives an error if one of the standard handles is closed. *)
  (* Unix.close Unix.stdin; *)
  out Unix.stdout "** create_process\n";
  test_createprocess env;
  out Unix.stdout "** create_process 2>&1 redirection\n";
  test_2ampsup1();
  out Unix.stdout "** create_process swap 1-2\n";
  test_swap12();
  out Unix.stdout "** create_process >file 2>&1\n";
  test_12tofile();
  out Unix.stdout "** open_process_in\n";
  test_open_process_in();
  out Unix.stdout "** open_process_out\n";
  test_open_process_out();
  out Unix.stdout "** open_process_full\n";
  test_open_process_full env