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
open Printf
open Fpath_.Operators
let list_map f l = List.rev_map f l |> List.rev
let list_flatten ll =
List.fold_left (fun acc l -> List.rev_append l acc) [] ll |> List.rev
let split_result_list xs =
let oks, errs =
List.fold_left
(fun (oks, errs) x ->
match x with
| Ok ok -> (ok :: oks, errs)
| Error err -> (oks, err :: errs))
([], []) xs
in
(List.rev oks, List.rev errs)
let string_for_all func str =
try
for i = 0 to String.length str - 1 do
if not (func str.[i]) then raise Exit
done;
true
with
| Exit -> false
let make_dir_if_not_exists ?(recursive = false) (dir : Fpath.t) =
let rec mkdir dir =
match (Unix.stat !!dir).st_kind with
| S_DIR -> ()
| S_REG
| S_CHR
| S_BLK
| S_LNK
| S_FIFO
| S_SOCK ->
Error.user_error
(sprintf
"File %S already exists but is not a folder as required by the \
testing setup."
!!dir)
| exception Unix.Unix_error (ENOENT, _, _) ->
let parent = Fpath_.dirname dir in
if parent = dir then
Error.user_error
(sprintf
"Folder %S doesn't exist and has no parent that we could create."
!!dir)
else if recursive then (
mkdir parent;
Unix.mkdir !!dir 0o777)
else if Sys.file_exists !!parent then Unix.mkdir !!dir 0o777
else
Error.user_error
(sprintf
"The parent folder of %S doesn't exist (current folder: %S)"
!!dir (Sys.getcwd ()))
in
dir |> Fpath.normalize |> Fpath.rem_empty_seg |> mkdir
let list_files dir =
let names = ref [] in
let dir = Unix.opendir !!dir in
Fun.protect
(fun () ->
try
while true do
match Unix.readdir dir with
| "."
| ".." ->
()
| name -> names := name :: !names
done
with
| End_of_file -> ())
~finally:(fun () -> Unix.closedir dir);
List.sort String.compare !names
let rec remove_file_or_dir path =
if Sys.file_exists !!path then
match (Unix.stat !!path).st_kind with
| S_DIR ->
path |> list_files
|> list_map (fun name -> path / name)
|> List.iter remove_file_or_dir;
Unix.rmdir !!path
| S_REG
| S_CHR
| S_BLK
| S_LNK
| S_FIFO
| S_SOCK ->
Sys.remove !!path
let contains_pcre_pattern ~pat =
let rex = Re.Pcre.regexp pat in
fun str -> Re.execp rex str
let contains_substring ~sub = contains_pcre_pattern ~pat:(Re.Pcre.quote sub)
let write_text_file path data =
let oc = open_out !!path in
Fun.protect
(fun () -> output_string oc data)
~finally:(fun () -> close_out_noerr oc)
let input_all ic =
let buf = Buffer.create 4096 in
let tmp = Bytes.create 4096 in
let rec loop () =
match input ic tmp 0 (Bytes.length tmp) with
| 0 -> ()
| n ->
Buffer.add_subbytes buf tmp 0 n;
loop ()
in
loop ();
Buffer.contents buf
let read_text_file path =
let ic = open_in !!path in
Fun.protect (fun () -> input_all ic) ~finally:(fun () -> close_in_noerr ic)
let map_text_file func src_path dst_path =
let old_contents = read_text_file src_path in
let new_contents = func old_contents in
write_text_file dst_path new_contents
let copy_text_file src_path dst_path =
map_text_file (fun data -> data) src_path dst_path
let chdir dir =
try Sys.chdir !!dir with
| e ->
failwith
(sprintf "Cannot chdir into '%s': %s" (Printexc.to_string e) !!dir)
let with_chdir path func =
let orig_cwd = Sys.getcwd () in
chdir path;
Fun.protect ~finally:(fun () -> Sys.chdir orig_cwd) func
let with_opt_chdir opt_path func =
match opt_path with
| None -> func ()
| Some path -> with_chdir path func