diff --git a/compiler/tests-ocaml/win-unicode/dune b/compiler/tests-ocaml/win-unicode/dune new file mode 100644 index 0000000000..c430927084 --- /dev/null +++ b/compiler/tests-ocaml/win-unicode/dune @@ -0,0 +1,5 @@ +(tests + (names + mltest) + (libraries ocaml_testing unix) + (modes js wasm)) diff --git a/compiler/tests-ocaml/win-unicode/mltest.ml b/compiler/tests-ocaml/win-unicode/mltest.ml new file mode 100644 index 0000000000..6d335a4c41 --- /dev/null +++ b/compiler/tests-ocaml/win-unicode/mltest.ml @@ -0,0 +1,291 @@ +(* TEST + include unix; + hasunix; + flags += "-strict-sequence -w +A -warn-error +A"; + windows-unicode; + toplevel; +*) + +let foreign_names = + List.sort compare + [ + "simple"; + "\xE4\xBD\xA0\xE5\xA5\xBD"; (* "你好" *) + "\x73\xC5\x93\x75\x72"; (* "sœur" *) + "e\204\129te\204\129"; (* "été" *) + ] +;; + +let test_files = + List.map (fun s -> s ^ ".txt") foreign_names +;; + +let to_create_and_delete_files = + [ + (* "верблюды" *) + "\xD0\xB2\xD0\xB5\xD1\x80\xD0\xB1\xD0\xBB\xD1\x8E\xD0\xB4\xD1\x8B"; + "\xE9\xAA\x86\xE9\xA9\xBC"; (* "骆驼" *) + "\215\167\215\162\215\158\215\156"; (* "קעמל" *) + "\216\167\217\136\217\134\217\185"; (* "اونٹ" *) + "L\225\186\161c \196\145\195\160"; (* "Lạc đà" *) + "\224\176\146\224\176\130\224\176\159\224\177\134"; (* "ఒంటె" *) + "\224\174\146\224\174\159\224\175\141\224\174\159\224\174\149\224\ + \174\174\224\175\141"; (* "ஒட்டகம்" *) + "\217\136\216\180\216\170\216\177"; (* "وشتر" *) + "\224\164\137\224\164\183\224\165\141\224\164\159\224\165\141\224\ + \164\176\224\164\131"; (* "उष्ट्रः" *) + "\216\167\217\186"; (* "اٺ" *) + ] +;; + +let foreign_names2 = + let rec take n l = + if n = 0 then [] + else List.hd l :: take (n-1) (List.tl l) + in + take (List.length foreign_names) to_create_and_delete_files +;; + +(* let env0 = + List.sort compare + (List.mapi (fun i v -> Printf.sprintf "OCAML_UTF8_VAR%d=%s" i v) + foreign_names2) *) + +(* let read_all ic = *) +(* set_binary_mode_in ic false; *) +(* let rec loop acc = *) +(* match input_line ic with *) +(* | exception End_of_file -> *) +(* List.rev acc *) +(* | s -> *) +(* loop (s :: acc) *) +(* in *) +(* loop [] *) + +(** WRAPPERS *) + +let getenvironmentenv s = + let env = Unix.environment () in + let rec loop i = + if i >= Array.length env then + "" + else begin + let e = env.(i) in + let pos = String.index e '=' in + if String.sub e 0 pos = s then + String.sub e (pos+1) (String.length e - pos - 1) + else + loop (i+1) + end + in + loop 0 +;; + +let unix_getcwd () = + Filename.basename (Unix.getcwd ()) +;; + +let sys_getcwd () = + Filename.basename (Sys.getcwd ()) +;; + +let unix_readdir s = + let h = Unix.opendir s in + let rec loop acc = + match Unix.readdir h with + | s -> + loop (s :: acc) + | exception End_of_file -> + Unix.closedir h; + acc + in + List.sort compare (loop []) +;; + +let sys_readdir s = + List.sort compare (Array.to_list (Sys.readdir s)) +;; + +(* let open_process_in cmdline = *) +(* let f cmdline = *) +(* let ic as proc = Unix.open_process_in cmdline in *) +(* let l = List.tl (read_all ic) in *) +(* ignore (Unix.close_process_in proc); *) +(* l *) +(* in *) +(* wrap "Unix.open_process_in" f ell cmdline (list quote) *) + +(* let open_process_full filter cmdline env = + let f cmdline env = + let (ic, _, _) as proc = + Unix.open_process_full cmdline (Array.of_list env) + in + let l = read_all ic in + ignore (Unix.close_process_full proc); + List.sort compare (List.filter filter l) + in + wrap2 "Unix.open_process_full" f ell (list quote) cmdline env (list quote) +*) + +let test_readdir readdir = + let filter s = List.mem s test_files && Filename.check_suffix s ".txt" in + List.filter filter (readdir Filename.current_dir_name) +;; + +let test_open_in () = + let check s = + let ic = open_in s in + let l = input_line ic in + close_in ic; + l + in + let filter s = List.mem s test_files in + let files = List.filter filter (sys_readdir Filename.current_dir_name) in + List.map check files +;; + +(* +let test_getenv () = + let equiv l r = + assert (l = r); + l, r + in + let doit key s = + Unix.putenv key s; + let l = equiv (Sys.getenv key) (getenvironmentenv key) in + let r = + Unix.putenv key (s ^ s); + equiv (Sys.getenv key) (getenvironmentenv key) + in + l, r + in + List.map2 doit foreign_names foreign_names2 +;; +*) + +let test_mkdir () = + let doit s = + Unix.mkdir s 0o755; + Sys.file_exists s, Sys.is_directory s + in + List.map doit foreign_names +;; + +let test_chdir chdir getcwd = + let doit s = + chdir s; + let d = getcwd () in + chdir Filename.parent_dir_name; + d + in + List.map doit foreign_names +;; + +let test_rmdir () = + let doit s = + Unix.rmdir s; + Sys.file_exists s + in + List.map doit foreign_names +;; + +let test_stat () = + let doit s = + (Unix.stat s).Unix.st_kind, + (Unix.lstat s).Unix.st_kind, + (Unix.LargeFile.stat s).Unix.LargeFile.st_kind, + (Unix.LargeFile.lstat s).Unix.LargeFile.st_kind + in + List.map doit to_create_and_delete_files +;; + +let test_access () = + List.iter (fun s -> Unix.access s [Unix.F_OK]) to_create_and_delete_files + +let test_rename rename = + let doit s = + let s' = s ^ "-1" in + rename s s'; + let x = Sys.file_exists s, Sys.file_exists s' in + rename s' s; + let y = Sys.file_exists s, Sys.file_exists s' in + x, y + in + List.map doit to_create_and_delete_files +;; + +let test_open_out () = + let doit s = + let oc = open_out s in + Printf.fprintf oc "Hello, %s\n" s; + close_out oc; + let ic = open_in s in + let l = input_line ic in + close_in ic; + l + in + List.map doit to_create_and_delete_files +;; + +let test_file_exists () = + List.map Sys.file_exists to_create_and_delete_files +;; + +let test_remove () = + let doit s = + Sys.remove s; + Sys.file_exists s + in + List.map doit to_create_and_delete_files +;; + +let create_file s = + let oc = open_out_bin s in + output_string oc s; + close_out oc +;; + +let test_symlink () = + let foodir = "UNIQU\xE4\xBD\xA0\xE5\xA5\xBD" (* "UNIQU你好" *) in + let foofile = "UNIQU\xE4\xBD\xA0\xE5\xA5\xBD/\xE4\xBD\xA0\xE5\xA5\xBD.txt" + (* "UNIQU你好/你好.txt" *) + in + let fileln = "\xE4\xBD\xA0\xE5\xA5\xBD-file-ln-s" (* "你好-file-ln-s" *) in + let dirln = "\xE4\xBD\xA0\xE5\xA5\xBD-dir-ln-s" (* "你好-dir-ln-s" *) in + Unix.mkdir foodir 0o777; + create_file foofile; + Unix.symlink ~to_dir:true foodir dirln; + Unix.symlink ~to_dir:false foofile fileln; + let res = + (Unix.stat fileln).Unix.st_kind = Unix.S_REG && + (Unix.stat dirln).Unix.st_kind = Unix.S_DIR && + (Unix.lstat fileln).Unix.st_kind = Unix.S_LNK && + (Unix.lstat dirln).Unix.st_kind = Unix.S_LNK + in + Sys.remove foofile; + Sys.remove fileln; + Sys.remove dirln; + Unix.rmdir foodir; + res +;; + +List.iter create_file test_files;; + +let check_length ?(n = 4) v = assert (List.length v = n);; + +let t_unix_readdir = check_length @@ test_readdir unix_readdir;; +let t_sys_readdir = check_length @@ test_readdir sys_readdir;; +let t_open_in = check_length @@ test_open_in ();; +let t_open_out = check_length ~n:10 @@ test_open_out ();; +let t_file_exists = assert (List.for_all Fun.id (test_file_exists ()));; +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 ()));; +test_access ();; +let t_unix_rename = test_rename Unix.rename;; +let t_sys_rename = test_rename Sys.rename;; +assert (not (List.exists Fun.id (test_remove ())));; +assert (List.for_all (fun (p, q) -> p && q) (test_mkdir ()));; +let t_sys_chdir = assert (foreign_names = test_chdir Sys.chdir sys_getcwd);; +let t_unix_chdir = assert (foreign_names = test_chdir Unix.chdir unix_getcwd);; +assert (not (List.exists Fun.id (test_rmdir ())));; +(*let t_getenv = test_getenv ();;*) +assert (if Unix.has_symlink () then test_symlink () else true);;