|
| 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