/usr/lib/ocaml/expect/expect.mli is in libexpect-ocaml-dev 0.0.5-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | (******************************************************************************)
(* ocaml-expect: Expect-like framework *)
(* *)
(* Copyright (C) 2013, Sylvain Le Gall *)
(* Copyright (C) 2010, OCamlCore SARL *)
(* *)
(* This library is free software; you can redistribute it and/or modify it *)
(* under the terms of the GNU Lesser General Public License as published by *)
(* the Free Software Foundation; either version 2.1 of the License, or (at *)
(* your option) any later version, with the OCaml static compilation *)
(* exception. *)
(* *)
(* This library is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *)
(* or FITNESS FOR A PARTICULAR PURPOSE. See the file COPYING for more *)
(* details. *)
(* *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this library; if not, write to the Free Software Foundation, *)
(* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *)
(******************************************************************************)
(** Expect module for testing interactive program.
This is a simple implementation of expect to help building unitary testing
of interactive program. Since this is an OCaml library, only specific part
of expect has been implemented. Other function can be replaced by standard
OCaml functions (exit...).
The use of this library is built around 4 functions:
- spawn: to create a process
- send: to send a string to the process
- expect: match output of the process
- close: end the process
Output of the program is processed line by line.
Regular expression is implemented through the library Str. You will need to
build a regexp using this module. The regexp should only match a substring
of the line. If you need to match something at the beginning or at the end,
use "^" and "$". To use a regexp
Additional match functions can be build using a standard function. This
function is passed the entire line and should return if it match or not.
There is two additional event to match:
- eof: process close its output
- timeout: too much time has been spent waiting to match something
Both of this action, if not matched will use the default_action provided.
Here is an example program, that look for string "." in the output:
{[
open Expect
let (), exit_code =
with_spawn "ls" [|"-alh"|]
(fun t () ->
if expect t [`Exact ".", true] false then
prerr_endline "'.' found"
else
prerr_endline "'.' not found")
()
in
match exit_code with
| Unix.WEXITED 0 ->
print_endline "Exit normal"
| _ ->
print_endline "Problem when exiting"
]}
See {{:http://directory.fsf.org/project/expect/}Expect manual}
@author Sylvain Le Gall
*)
(** A process under the monitoring of Expect.
*)
type t
(** Describe expectation about the output of the process. Lines includes the EOL
(i.e. \n).
*)
type expect_match =
[
`Eof (** Look for EOF *)
| `Fun of (string -> bool) (** Look for a line matching the string *)
| `Exact of string (** Look for a line matching exactly this
string *)
| `Suffix of string (** Look for a line ending with this
string *)
| `Prefix of string (** Look for a line starting with this
string *)
| `Contains of string (** Look for a line containing this
string *)
| `Timeout (* Wait timeout *)
]
(** [spawn prg args] Start a process and monitor its output. Contrary to
[Unix.create_process], you don't need to repeat the program name at the
beginning of args.
Optional parameters:
- [~timeout]: define the default timeout, in seconds. None means that
you can wait forever
- [~env]: provide environment to run the process
- [~use_stderr]: redirect stderr to stdout and process it through expect
*)
val spawn:
?verbose:bool ->
?verbose_output:(string -> unit) ->
?timeout:float option ->
?env:string array ->
?use_stderr:bool ->
string -> string array -> t
(** Define the timeout for a process.
*)
val set_timeout: t -> float option -> t
(** Send a string to a process.
*)
val send: t -> string -> unit
(** [expect t ~fmatches matches dflt] Waits for output of the process and match
it against expectations [matches]. If no expectations match at timeout,
returns [dflt]. You can use [~fmatch] to define while processing the output
what the result is, if you find a match, return [Some res] otherwise return
[None]. The function take into account [matches] before [~fmatch] and it
picks the first result which is not [None].
*)
val expect:
t ->
?fmatches:(string -> 'a option) list ->
(expect_match * 'a) list -> 'a -> 'a
(** Close the process.
*)
val close: t -> Unix.process_status
(** Take care of opening and closing the process.
*)
val with_spawn:
?verbose:bool ->
?verbose_output:(string -> unit) ->
?timeout:float option ->
?env:string array ->
?use_stderr:bool ->
string -> string array ->
(t -> 'a -> 'a) -> 'a -> 'a * Unix.process_status
|