Skip to content

Commit 59aac2f

Browse files
committed
Add test from OCaml test suite
1 parent e816318 commit 59aac2f

File tree

2 files changed

+296
-0
lines changed

2 files changed

+296
-0
lines changed

compiler/tests-ocaml/win-unicode/dune

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
(tests
2+
(names
3+
mltest)
4+
(libraries ocaml_testing unix)
5+
(modes js wasm))
Lines changed: 291 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,291 @@
1+
(* TEST
2+
include unix;
3+
hasunix;
4+
flags += "-strict-sequence -w +A -warn-error +A";
5+
windows-unicode;
6+
toplevel;
7+
*)
8+
9+
let foreign_names =
10+
List.sort compare
11+
[
12+
"simple";
13+
"\xE4\xBD\xA0\xE5\xA5\xBD"; (* "你好" *)
14+
"\x73\xC5\x93\x75\x72"; (* "sœur" *)
15+
"e\204\129te\204\129"; (* "été" *)
16+
]
17+
;;
18+
19+
let test_files =
20+
List.map (fun s -> s ^ ".txt") foreign_names
21+
;;
22+
23+
let to_create_and_delete_files =
24+
[
25+
(* "верблюды" *)
26+
"\xD0\xB2\xD0\xB5\xD1\x80\xD0\xB1\xD0\xBB\xD1\x8E\xD0\xB4\xD1\x8B";
27+
"\xE9\xAA\x86\xE9\xA9\xBC"; (* "骆驼" *)
28+
"\215\167\215\162\215\158\215\156"; (* "קעמל" *)
29+
"\216\167\217\136\217\134\217\185"; (* "اونٹ" *)
30+
"L\225\186\161c \196\145\195\160"; (* "Lạc đà" *)
31+
"\224\176\146\224\176\130\224\176\159\224\177\134"; (* "ఒంటె" *)
32+
"\224\174\146\224\174\159\224\175\141\224\174\159\224\174\149\224\
33+
\174\174\224\175\141"; (* "ஒட்டகம்" *)
34+
"\217\136\216\180\216\170\216\177"; (* "وشتر" *)
35+
"\224\164\137\224\164\183\224\165\141\224\164\159\224\165\141\224\
36+
\164\176\224\164\131"; (* "उष्ट्रः" *)
37+
"\216\167\217\186"; (* "اٺ" *)
38+
]
39+
;;
40+
41+
let foreign_names2 =
42+
let rec take n l =
43+
if n = 0 then []
44+
else List.hd l :: take (n-1) (List.tl l)
45+
in
46+
take (List.length foreign_names) to_create_and_delete_files
47+
;;
48+
49+
(* let env0 =
50+
List.sort compare
51+
(List.mapi (fun i v -> Printf.sprintf "OCAML_UTF8_VAR%d=%s" i v)
52+
foreign_names2) *)
53+
54+
(* let read_all ic = *)
55+
(* set_binary_mode_in ic false; *)
56+
(* let rec loop acc = *)
57+
(* match input_line ic with *)
58+
(* | exception End_of_file -> *)
59+
(* List.rev acc *)
60+
(* | s -> *)
61+
(* loop (s :: acc) *)
62+
(* in *)
63+
(* loop [] *)
64+
65+
(** WRAPPERS *)
66+
67+
let getenvironmentenv s =
68+
let env = Unix.environment () in
69+
let rec loop i =
70+
if i >= Array.length env then
71+
""
72+
else begin
73+
let e = env.(i) in
74+
let pos = String.index e '=' in
75+
if String.sub e 0 pos = s then
76+
String.sub e (pos+1) (String.length e - pos - 1)
77+
else
78+
loop (i+1)
79+
end
80+
in
81+
loop 0
82+
;;
83+
84+
let unix_getcwd () =
85+
Filename.basename (Unix.getcwd ())
86+
;;
87+
88+
let sys_getcwd () =
89+
Filename.basename (Sys.getcwd ())
90+
;;
91+
92+
let unix_readdir s =
93+
let h = Unix.opendir s in
94+
let rec loop acc =
95+
match Unix.readdir h with
96+
| s ->
97+
loop (s :: acc)
98+
| exception End_of_file ->
99+
Unix.closedir h;
100+
acc
101+
in
102+
List.sort compare (loop [])
103+
;;
104+
105+
let sys_readdir s =
106+
List.sort compare (Array.to_list (Sys.readdir s))
107+
;;
108+
109+
(* let open_process_in cmdline = *)
110+
(* let f cmdline = *)
111+
(* let ic as proc = Unix.open_process_in cmdline in *)
112+
(* let l = List.tl (read_all ic) in *)
113+
(* ignore (Unix.close_process_in proc); *)
114+
(* l *)
115+
(* in *)
116+
(* wrap "Unix.open_process_in" f ell cmdline (list quote) *)
117+
118+
(* let open_process_full filter cmdline env =
119+
let f cmdline env =
120+
let (ic, _, _) as proc =
121+
Unix.open_process_full cmdline (Array.of_list env)
122+
in
123+
let l = read_all ic in
124+
ignore (Unix.close_process_full proc);
125+
List.sort compare (List.filter filter l)
126+
in
127+
wrap2 "Unix.open_process_full" f ell (list quote) cmdline env (list quote)
128+
*)
129+
130+
let test_readdir readdir =
131+
let filter s = List.mem s test_files && Filename.check_suffix s ".txt" in
132+
List.filter filter (readdir Filename.current_dir_name)
133+
;;
134+
135+
let test_open_in () =
136+
let check s =
137+
let ic = open_in s in
138+
let l = input_line ic in
139+
close_in ic;
140+
l
141+
in
142+
let filter s = List.mem s test_files in
143+
let files = List.filter filter (sys_readdir Filename.current_dir_name) in
144+
List.map check files
145+
;;
146+
147+
(*
148+
let test_getenv () =
149+
let equiv l r =
150+
assert (l = r);
151+
l, r
152+
in
153+
let doit key s =
154+
Unix.putenv key s;
155+
let l = equiv (Sys.getenv key) (getenvironmentenv key) in
156+
let r =
157+
Unix.putenv key (s ^ s);
158+
equiv (Sys.getenv key) (getenvironmentenv key)
159+
in
160+
l, r
161+
in
162+
List.map2 doit foreign_names foreign_names2
163+
;;
164+
*)
165+
166+
let test_mkdir () =
167+
let doit s =
168+
Unix.mkdir s 0o755;
169+
Sys.file_exists s, Sys.is_directory s
170+
in
171+
List.map doit foreign_names
172+
;;
173+
174+
let test_chdir chdir getcwd =
175+
let doit s =
176+
chdir s;
177+
let d = getcwd () in
178+
chdir Filename.parent_dir_name;
179+
d
180+
in
181+
List.map doit foreign_names
182+
;;
183+
184+
let test_rmdir () =
185+
let doit s =
186+
Unix.rmdir s;
187+
Sys.file_exists s
188+
in
189+
List.map doit foreign_names
190+
;;
191+
192+
let test_stat () =
193+
let doit s =
194+
(Unix.stat s).Unix.st_kind,
195+
(Unix.lstat s).Unix.st_kind,
196+
(Unix.LargeFile.stat s).Unix.LargeFile.st_kind,
197+
(Unix.LargeFile.lstat s).Unix.LargeFile.st_kind
198+
in
199+
List.map doit to_create_and_delete_files
200+
;;
201+
202+
let test_access () =
203+
List.iter (fun s -> Unix.access s [Unix.F_OK]) to_create_and_delete_files
204+
205+
let test_rename rename =
206+
let doit s =
207+
let s' = s ^ "-1" in
208+
rename s s';
209+
let x = Sys.file_exists s, Sys.file_exists s' in
210+
rename s' s;
211+
let y = Sys.file_exists s, Sys.file_exists s' in
212+
x, y
213+
in
214+
List.map doit to_create_and_delete_files
215+
;;
216+
217+
let test_open_out () =
218+
let doit s =
219+
let oc = open_out s in
220+
Printf.fprintf oc "Hello, %s\n" s;
221+
close_out oc;
222+
let ic = open_in s in
223+
let l = input_line ic in
224+
close_in ic;
225+
l
226+
in
227+
List.map doit to_create_and_delete_files
228+
;;
229+
230+
let test_file_exists () =
231+
List.map Sys.file_exists to_create_and_delete_files
232+
;;
233+
234+
let test_remove () =
235+
let doit s =
236+
Sys.remove s;
237+
Sys.file_exists s
238+
in
239+
List.map doit to_create_and_delete_files
240+
;;
241+
242+
let create_file s =
243+
let oc = open_out_bin s in
244+
output_string oc s;
245+
close_out oc
246+
;;
247+
248+
let test_symlink () =
249+
let foodir = "UNIQU\xE4\xBD\xA0\xE5\xA5\xBD" (* "UNIQU你好" *) in
250+
let foofile = "UNIQU\xE4\xBD\xA0\xE5\xA5\xBD/\xE4\xBD\xA0\xE5\xA5\xBD.txt"
251+
(* "UNIQU你好/你好.txt" *)
252+
in
253+
let fileln = "\xE4\xBD\xA0\xE5\xA5\xBD-file-ln-s" (* "你好-file-ln-s" *) in
254+
let dirln = "\xE4\xBD\xA0\xE5\xA5\xBD-dir-ln-s" (* "你好-dir-ln-s" *) in
255+
Unix.mkdir foodir 0o777;
256+
create_file foofile;
257+
Unix.symlink ~to_dir:true foodir dirln;
258+
Unix.symlink ~to_dir:false foofile fileln;
259+
let res =
260+
(Unix.stat fileln).Unix.st_kind = Unix.S_REG &&
261+
(Unix.stat dirln).Unix.st_kind = Unix.S_DIR &&
262+
(Unix.lstat fileln).Unix.st_kind = Unix.S_LNK &&
263+
(Unix.lstat dirln).Unix.st_kind = Unix.S_LNK
264+
in
265+
Sys.remove foofile;
266+
Sys.remove fileln;
267+
Sys.remove dirln;
268+
Unix.rmdir foodir;
269+
res
270+
;;
271+
272+
List.iter create_file test_files;;
273+
274+
let check_length ?(n = 4) v = assert (List.length v = n);;
275+
276+
let t_unix_readdir = check_length @@ test_readdir unix_readdir;;
277+
let t_sys_readdir = check_length @@ test_readdir sys_readdir;;
278+
let t_open_in = check_length @@ test_open_in ();;
279+
let t_open_out = check_length ~n:10 @@ test_open_out ();;
280+
let t_file_exists = assert (List.for_all Fun.id (test_file_exists ()));;
281+
let t_stat = assert (List.for_all (fun x -> match x with Unix.S_REG,Unix.S_REG,Unix.S_REG,Unix.S_REG -> true | _ -> false) (test_stat ()));;
282+
test_access ();;
283+
let t_unix_rename = test_rename Unix.rename;;
284+
let t_sys_rename = test_rename Sys.rename;;
285+
assert (not (List.exists Fun.id (test_remove ())));;
286+
assert (List.for_all (fun (p, q) -> p && q) (test_mkdir ()));;
287+
let t_sys_chdir = assert (foreign_names = test_chdir Sys.chdir sys_getcwd);;
288+
let t_unix_chdir = assert (foreign_names = test_chdir Unix.chdir unix_getcwd);;
289+
assert (not (List.exists Fun.id (test_rmdir ())));;
290+
(*let t_getenv = test_getenv ();;*)
291+
assert (if Unix.has_symlink () then test_symlink () else true);;

0 commit comments

Comments
 (0)