2735

Committed 15 Jan 2025 05:29PM UTC coverage: 73.399% (-0.07%) from 73.471%

Build # 2735

Build Type

push

github

Committed by

jonludlam

Commit Message

Update test results

Run Details

10256 of 13973 relevant lines covered (73.4%)

9962.83 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

60.4

/src/odoc/fs.ml

(*
 * Copyright (c) 2016 Thomas Refis <trefis@janestreet.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open StdLabels
open Or_error

type directory = Fpath.t

type file = Fpath.t

let mkdir_p dir =
  let mkdir d =
    try Unix.mkdir (Fpath.to_string d) 0o755 with
    | Unix.Unix_error (Unix.EEXIST, _, _) -> ()
    | exn -> raise exn
  in
  let rec dirs_to_create p acc =
    if Sys.file_exists (Fpath.to_string p) then acc
    else dirs_to_create (Fpath.parent p) (p :: acc)
  in
  List.iter (dirs_to_create (Fpath.normalize dir) []) ~f:mkdir

module File = struct
  type t = file

  let dirname = Fpath.parent

  let basename = Fpath.base

  let append = Fpath.append

  let set_ext e p = Fpath.set_ext e p

  let has_ext e p = Fpath.has_ext e p

  let get_ext e = Fpath.get_ext e

  let create ~directory ~name =
    match Fpath.of_string name with
    | Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.File.create: " ^ e)
    | Result.Ok psuf -> Fpath.(normalize @@ (directory // psuf))

  let to_string = Fpath.to_string
  let segs = Fpath.segs

  let of_string s =
    match Fpath.of_string s with
    | Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.File.of_string: " ^ e)
    | Result.Ok p -> p

  let read file =
    let with_ic ~close ic f =
      let close ic = try close ic with Sys_error _ -> () in
      match f ic with
      | v ->
          close ic;
          v
      | exception e ->
          close ic;
          raise e
    in
    let input_one_shot len ic =
      let buf = Bytes.create len in
      really_input ic buf 0 len;
      close_in ic;
      Result.Ok (Bytes.unsafe_to_string buf)
    in
    let input_stream file ic =
      let bsize = 65536 (* IO_BUFFER_SIZE *) in
      let buf = Buffer.create bsize in
      let rec loop () =
        match Buffer.add_channel buf ic bsize with
        | () -> loop ()
        | exception End_of_file -> Result.Ok (Buffer.contents buf)
        | exception Failure _ ->
            Result.Error (`Msg (Printf.sprintf "%s: input too large" file))
      in
      loop ()
    in
    try
      let file = Fpath.to_string file in
      let is_dash = file = "-" in
      let ic = if is_dash then stdin else open_in_bin file in
      let close ic = if is_dash then () else close_in ic in
      with_ic ~close ic @@ fun ic ->
      match in_channel_length ic with
      | 0 (* e.g. stdin or /dev/stdin *) -> input_stream file ic
      | len when len <= Sys.max_string_length -> input_one_shot len ic
      | len ->
          let err = Printf.sprintf "%s: file too large (%d bytes)" file len in
          Result.Error (`Msg err)
    with Sys_error e -> Result.Error (`Msg e)

  let copy ~src ~dst =
    let with_ open_ close filename f =
      let c = open_ (Fpath.to_string filename) in
      Odoc_utils.Fun.protect ~finally:(fun () -> close c) (fun () -> f c)
    in
    let with_ic = with_ open_in_bin close_in_noerr in
    let with_oc = with_ open_out_bin close_out_noerr in
    try
      with_ic src (fun ic ->
          mkdir_p (dirname dst);
          with_oc dst (fun oc ->
              let len = 65536 in
              let buf = Bytes.create len in
              let rec loop () =
                let read = input ic buf 0 len in
                if read > 0 then (
                  output oc buf 0 read;
                  loop ())
              in
              Ok (loop ())))
    with Sys_error e -> Result.Error (`Msg e)

  let exists file = Sys.file_exists (Fpath.to_string file)

  let rec of_segs_tl acc = function
    | [] -> acc
    | hd :: tl -> of_segs_tl (Fpath.( / ) acc hd) tl

  let of_segs = function
    | [] -> invalid_arg "Fs.File.of_segs"
    | "" :: rest -> of_segs_tl (Fpath.v "/") rest
    | first :: rest -> of_segs_tl (Fpath.v first) rest

  let append_segs path segs = of_segs_tl path segs

  module Table = Hashtbl.Make (struct
    type nonrec t = t

    let equal = Fpath.equal

    let hash = Hashtbl.hash
  end)
end

module Directory = struct
  type t = directory

  let dirname = Fpath.parent

  let basename = Fpath.base

  let append = Fpath.append

  let make_path p name =
    match Fpath.of_string name with
    | Result.Error _ as e -> e
    | Result.Ok psuf ->
        Result.Ok Fpath.(normalize @@ to_dir_path @@ (p // psuf))

  let reach_from ~dir path =
    match make_path dir path with
    | Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.Directory.create: " ^ e)
    | Result.Ok path ->
        let pstr = Fpath.to_string path in
        if Sys.file_exists pstr && not (Sys.is_directory pstr) then
          invalid_arg "Odoc.Fs.Directory.create: not a directory";
        path

  let contains ~parentdir f = Fpath.is_rooted ~root:parentdir f

  let compare = Fpath.compare

  let mkdir_p dir = mkdir_p dir

  let to_string = Fpath.to_string

  let to_fpath x = x

  let of_string s =
    match Fpath.of_string s with
    | Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.Directory.of_string: " ^ e)
    | Result.Ok p -> Fpath.to_dir_path p

  let of_file f = Fpath.to_dir_path f

  let fold_files_rec ?(ext = "") f acc d =
    let fold_non_dirs ext f acc files =
      let is_dir d = try Sys.is_directory d with Sys_error _ -> false in
      let has_ext ext file = Filename.check_suffix file ext in
      let dirs, files = List.partition ~f:is_dir files in
      let files = List.find_all ~f:(has_ext ext) files in
      let f acc fn = f acc (Fpath.v fn) in
      (List.fold_left ~f ~init:acc files, dirs)
    in
    let rec loop ext f acc = function
      | (d :: ds) :: up ->
          let rdir d =
            try Array.to_list (Sys.readdir d) with Sys_error _ -> []
          in
          let files = List.rev (List.rev_map ~f:(Filename.concat d) (rdir d)) in
          let acc, dirs = fold_non_dirs ext f acc files in
          loop ext f acc (dirs :: ds :: up)
      | [] :: up -> loop ext f acc up
      | [] -> acc
    in
    loop ext f acc [ [ Fpath.to_string d ] ]

  exception Stop_iter of msg

  let fold_files_rec_result ?ext f acc d =
    let f acc fn =
      match f acc fn with Ok acc -> acc | Error e -> raise (Stop_iter e)
    in
    try Ok (fold_files_rec ?ext f acc d)
    with Stop_iter (`Msg _ as e) -> Error e

  module Table = Hashtbl.Make (struct
    type nonrec t = t

    let equal = Fpath.equal

    let hash = Hashtbl.hash
  end)
end

1	(*
2	* Copyright (c) 2016 Thomas Refis <trefis@janestreet.com>
3	*
4	* Permission to use, copy, modify, and distribute this software for any
5	* purpose with or without fee is hereby granted, provided that the above
6	* copyright notice and this permission notice appear in all copies.
7	*
8	* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9	* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10	* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11	* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12	* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13	* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14	* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15	*)
16
17	open StdLabels
18	open Or_error
19
20	type directory = Fpath.t
21
22	type file = Fpath.t
23
24	let mkdir_p dir =
25	let mkdir d =	2,971✔
26	try Unix.mkdir (Fpath.to_string d) 0o755 with	379✔
27	\| Unix.Unix_error (Unix.EEXIST, _, _) -> ()	×
28	\| exn -> raise exn	×
29	in
30	let rec dirs_to_create p acc =
31	if Sys.file_exists (Fpath.to_string p) then acc	2,971✔
32	else dirs_to_create (Fpath.parent p) (p :: acc)	379✔
33	in
34	List.iter (dirs_to_create (Fpath.normalize dir) []) ~f:mkdir	2,971✔
35
36	module File = struct
37	type t = file
38
39	let dirname = Fpath.parent
40
41	let basename = Fpath.base
42
43	let append = Fpath.append
44
45	let set_ext e p = Fpath.set_ext e p	613✔
46
47	let has_ext e p = Fpath.has_ext e p	347✔
48
49	let get_ext e = Fpath.get_ext e	392✔
50
51	let create ~directory ~name =
52	match Fpath.of_string name with	947✔
53	\| Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.File.create: " ^ e)	×
54	\| Result.Ok psuf -> Fpath.(normalize @@ (directory // psuf))	947✔
55
56	let to_string = Fpath.to_string
57	let segs = Fpath.segs
58
59	let of_string s =
60	match Fpath.of_string s with	1,227✔
61	\| Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.File.of_string: " ^ e)	×
62	\| Result.Ok p -> p	1,227✔
63
64	let read file =
65	let with_ic ~close ic f =	117✔
66	let close ic = try close ic with Sys_error _ -> () in	×
67	match f ic with
68	\| v ->	117✔
69	close ic;
70	v	117✔
71	\| exception e ->	×
72	close ic;
73	raise e	×
74	in
75	let input_one_shot len ic =
76	let buf = Bytes.create len in	117✔
77	really_input ic buf 0 len;	117✔
78	close_in ic;	117✔
79	Result.Ok (Bytes.unsafe_to_string buf)	117✔
80	in
81	let input_stream file ic =
82	let bsize = 65536 (* IO_BUFFER_SIZE *) in	×
83	let buf = Buffer.create bsize in
84	let rec loop () =	×
85	match Buffer.add_channel buf ic bsize with	×
86	\| () -> loop ()	×
87	\| exception End_of_file -> Result.Ok (Buffer.contents buf)	×
88	\| exception Failure _ ->	×
89	Result.Error (`Msg (Printf.sprintf "%s: input too large" file))	×
90	in
91	loop ()
92	in
93	try
94	let file = Fpath.to_string file in
95	let is_dash = file = "-" in	117✔
96	let ic = if is_dash then stdin else open_in_bin file in	×
97	let close ic = if is_dash then () else close_in ic in	×
98	with_ic ~close ic @@ fun ic ->	117✔
99	match in_channel_length ic with	117✔
100	\| 0 (* e.g. stdin or /dev/stdin *) -> input_stream file ic	×
101	\| len when len <= Sys.max_string_length -> input_one_shot len ic	117✔
102	\| len ->	×
103	let err = Printf.sprintf "%s: file too large (%d bytes)" file len in
104	Result.Error (`Msg err)	×
105	with Sys_error e -> Result.Error (`Msg e)	×
106
107	let copy ~src ~dst =
108	let with_ open_ close filename f =	1✔
109	let c = open_ (Fpath.to_string filename) in	2✔
110	Odoc_utils.Fun.protect ~finally:(fun () -> close c) (fun () -> f c)	2✔
111	in
112	let with_ic = with_ open_in_bin close_in_noerr in
113	let with_oc = with_ open_out_bin close_out_noerr in	1✔
114	try	1✔
115	with_ic src (fun ic ->	1✔
116	mkdir_p (dirname dst);	1✔
117	with_oc dst (fun oc ->	1✔
118	let len = 65536 in	1✔
119	let buf = Bytes.create len in
120	let rec loop () =	1✔
121	let read = input ic buf 0 len in	2✔
122	if read > 0 then (	1✔
123	output oc buf 0 read;
124	loop ())	1✔
125	in
126	Ok (loop ())))	1✔
127	with Sys_error e -> Result.Error (`Msg e)	×
128
129	let exists file = Sys.file_exists (Fpath.to_string file)	45✔
130
131	let rec of_segs_tl acc = function
132	\| [] -> acc	179✔
133	\| hd :: tl -> of_segs_tl (Fpath.( / ) acc hd) tl	96✔
134
135	let of_segs = function
136	\| [] -> invalid_arg "Fs.File.of_segs"	×
137	\| "" :: rest -> of_segs_tl (Fpath.v "/") rest	×
138	\| first :: rest -> of_segs_tl (Fpath.v first) rest	179✔
139
140	let append_segs path segs = of_segs_tl path segs	×
141
142	module Table = Hashtbl.Make (struct
143	type nonrec t = t
144
145	let equal = Fpath.equal
146
147	let hash = Hashtbl.hash
148	end)
149	end
150
151	module Directory = struct
152	type t = directory
153
154	let dirname = Fpath.parent
155
156	let basename = Fpath.base
157
158	let append = Fpath.append
159
160	let make_path p name =
161	match Fpath.of_string name with	×
162	\| Result.Error _ as e -> e	×
163	\| Result.Ok psuf ->	×
164	Result.Ok Fpath.(normalize @@ to_dir_path @@ (p // psuf))	×
165
166	let reach_from ~dir path =
167	match make_path dir path with	×
168	\| Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.Directory.create: " ^ e)	×
169	\| Result.Ok path ->	×
170	let pstr = Fpath.to_string path in
171	if Sys.file_exists pstr && not (Sys.is_directory pstr) then	×
172	invalid_arg "Odoc.Fs.Directory.create: not a directory";	×
173	path	×
174
175	let contains ~parentdir f = Fpath.is_rooted ~root:parentdir f	37✔
176
177	let compare = Fpath.compare
178
179	let mkdir_p dir = mkdir_p dir	2,970✔
180
181	let to_string = Fpath.to_string
182
183	let to_fpath x = x	240✔
184
185	let of_string s =
186	match Fpath.of_string s with	1,267✔
187	\| Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.Directory.of_string: " ^ e)	×
188	\| Result.Ok p -> Fpath.to_dir_path p	1,267✔
189
190	let of_file f = Fpath.to_dir_path f	×
191
192	let fold_files_rec ?(ext = "") f acc d =	×
193	let fold_non_dirs ext f acc files =	26✔
194	let is_dir d = try Sys.is_directory d with Sys_error _ -> false in	×
195	let has_ext ext file = Filename.check_suffix file ext in	394✔
196	let dirs, files = List.partition ~f:is_dir files in
197	let files = List.find_all ~f:(has_ext ext) files in	72✔
198	let f acc fn = f acc (Fpath.v fn) in	72✔
199	(List.fold_left ~f ~init:acc files, dirs)	72✔
200	in
201	let rec loop ext f acc = function
202	\| (d :: ds) :: up ->	72✔
203	let rdir d =
204	try Array.to_list (Sys.readdir d) with Sys_error _ -> []	1✔
205	in
206	let files = List.rev (List.rev_map ~f:(Filename.concat d) (rdir d)) in	72✔
207	let acc, dirs = fold_non_dirs ext f acc files in	72✔
208	loop ext f acc (dirs :: ds :: up)	72✔
209	\| [] :: up -> loop ext f acc up	98✔
210	\| [] -> acc	26✔
211	in
212	loop ext f acc [ [ Fpath.to_string d ] ]	26✔
213
214	exception Stop_iter of msg
215
216	let fold_files_rec_result ?ext f acc d =
217	let f acc fn =	9✔
218	match f acc fn with Ok acc -> acc \| Error e -> raise (Stop_iter e)	×
219	in
220	try Ok (fold_files_rec ?ext f acc d)	9✔
221	with Stop_iter (`Msg _ as e) -> Error e	×
222
223	module Table = Hashtbl.Make (struct
224	type nonrec t = t
225
226	let equal = Fpath.equal
227
228	let hash = Hashtbl.hash
229	end)
230	end

ocaml / odoc / 2735

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous