My working unpac space for OCaml projects in development
Merge opam/patches/fpath
+3193
+4
vendor/opam/fpath/.merlin
+4
vendor/opam/fpath/.merlin
+1
vendor/opam/fpath/.ocp-indent
+1
vendor/opam/fpath/.ocp-indent
···
1
+
strict_with=always,match_clause=4,strict_else=never
+53
vendor/opam/fpath/B0.ml
+53
vendor/opam/fpath/B0.ml
···
1
+
open B0_kit.V000
2
+
3
+
(* OCaml library names *)
4
+
5
+
let astring = B0_ocaml.libname "astring"
6
+
let b0_std = B0_ocaml.libname "b0.std"
7
+
let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel"
8
+
9
+
let fpath = B0_ocaml.libname "fpath"
10
+
let fpath_top = B0_ocaml.libname "fpath.top"
11
+
12
+
(* Libraries *)
13
+
14
+
let fpath_lib =
15
+
let srcs = [`Dir ~/"src/"; `X ~/"src/fpath_top_init.ml"] in
16
+
B0_ocaml.lib fpath ~srcs ~requires:[astring]
17
+
18
+
let fpath_top_lib =
19
+
let srcs = [ `Dir ~/"src/top" ] in
20
+
B0_ocaml.lib fpath_top ~srcs ~requires:[fpath; compiler_libs_toplevel]
21
+
22
+
(* Tests *)
23
+
24
+
let test_fpath =
25
+
let srcs = [ `Dir ~/"test" ] in
26
+
B0_ocaml.test ~/"test/test_fpath.ml" ~srcs ~requires:[b0_std; fpath]
27
+
28
+
(* Packs *)
29
+
30
+
let default =
31
+
let meta =
32
+
B0_meta.empty
33
+
|> ~~ B0_meta.authors ["The fpath programmers"]
34
+
|> ~~ B0_meta.maintainers ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
35
+
|> ~~ B0_meta.homepage "https://erratique.ch/software/fpath"
36
+
|> ~~ B0_meta.online_doc "https://erratique.ch/software/fpath/doc/"
37
+
|> ~~ B0_meta.licenses ["ISC" ]
38
+
|> ~~ B0_meta.repo "git+https://erratique.ch/repos/fpath.git"
39
+
|> ~~ B0_meta.issues "https://github.com/dbuenzli/fpath/issues"
40
+
|> ~~ B0_meta.description_tags
41
+
["file"; "system"; "path"; "org:erratique"]
42
+
|> ~~ B0_opam.depends
43
+
[ "ocaml", {|>= "4.08.0"|};
44
+
"ocamlfind", {|build|};
45
+
"ocamlbuild", {|build|};
46
+
"topkg", {|build & >= "1.1.0"|};
47
+
]
48
+
|> ~~ B0_opam.build
49
+
{|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|}
50
+
|> B0_meta.tag B0_opam.tag
51
+
in
52
+
B0_pack.make "default" ~doc:"fpath package" ~meta ~locked:true @@
53
+
B0_unit.list ()
vendor/opam/fpath/BRZO
vendor/opam/fpath/BRZO
This is a binary file and will not be displayed.
+29
vendor/opam/fpath/CHANGES.md
+29
vendor/opam/fpath/CHANGES.md
···
1
+
2
+
- `Fpath.relativize` improve docs and change some correct but
3
+
surpising results. Thanks to Martin Jambon for the report (#20).
4
+
5
+
v0.7.3 2020-09-08 Zagreb
6
+
------------------------
7
+
8
+
- Require OCaml 4.03 and drop `result` compatibility package
9
+
- Support OCaml 4.12 injectiviy annotation of Map.S (#18).
10
+
Thanks to Kate for the patch.
11
+
12
+
v0.7.2 2017-05-04 La Forclaz (VS)
13
+
---------------------------------
14
+
15
+
- Fix `odoc` documentation generation.
16
+
- Document the error message of `Fpath.of_string` so that
17
+
client can rely and build on it.
18
+
19
+
v0.7.1 2016-07-12 Cambridge (UK)
20
+
--------------------------------
21
+
22
+
- Add `Fpath.mem_ext`.
23
+
- Documentation fixes.
24
+
25
+
26
+
v0.7.0 2016-05-23 La Forclaz (VS)
27
+
---------------------------------
28
+
29
+
First release. Many thanks to David Sheets for his review of the API.
+5
vendor/opam/fpath/DEVEL.md
+5
vendor/opam/fpath/DEVEL.md
+13
vendor/opam/fpath/LICENSE.md
+13
vendor/opam/fpath/LICENSE.md
···
1
+
Copyright (c) 2014 The fpath programmers
2
+
3
+
Permission to use, copy, modify, and/or distribute this software for any
4
+
purpose with or without fee is hereby granted, provided that the above
5
+
copyright notice and this permission notice appear in all copies.
6
+
7
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+32
vendor/opam/fpath/README.md
+32
vendor/opam/fpath/README.md
···
1
+
Fpath — File system paths for OCaml
2
+
===================================
3
+
4
+
Fpath is an OCaml module for handling file system paths with POSIX or
5
+
Windows conventions. Fpath processes paths without accessing the file
6
+
system and is independent from any system library.
7
+
8
+
Fpath depends on [Astring] and is distributed under the ISC license.
9
+
10
+
[astring]: http://erratique.ch/software/astring
11
+
12
+
Home page: <http://erratique.ch/software/fpath>
13
+
14
+
## Installation
15
+
16
+
Fpath can be installed with `opam`:
17
+
18
+
opam install fpath
19
+
20
+
If you don't use `opam` consult the [`opam`](opam) file for build
21
+
instructions.
22
+
23
+
## Documentation
24
+
25
+
The documentation can be consulted [online] or via `odig doc fpath`.
26
+
27
+
Questions are welcome but better asked on the [OCaml forum] than on
28
+
the issue tracker.
29
+
30
+
[online]: https://erratique.ch/software/fpath
31
+
[OCaml forum]: https://discuss.ocaml.org/
32
+
+11
vendor/opam/fpath/doc/index.mld
+11
vendor/opam/fpath/doc/index.mld
···
1
+
{0 Fpath {%html: <span class="version">%%VERSION%%</span>%}}
2
+
3
+
Fpath handles file system paths with POSIX or Windows conventions. It
4
+
processes paths without accessing the file system and is independent
5
+
from any system library.
6
+
7
+
{1:api API}
8
+
9
+
{!modules:
10
+
Fpath
11
+
}
vendor/opam/fpath/fpath.opam
vendor/opam/fpath/fpath.opam
This is a binary file and will not be displayed.
+29
vendor/opam/fpath/opam
+29
vendor/opam/fpath/opam
···
1
+
opam-version: "2.0"
2
+
name: "fpath"
3
+
synopsis: "File system paths for OCaml"
4
+
description: """\
5
+
Fpath is an OCaml module for handling file system paths with POSIX or
6
+
Windows conventions. Fpath processes paths without accessing the file
7
+
system and is independent from any system library.
8
+
9
+
Fpath depends on [Astring][astring] and is distributed under the ISC
10
+
license.
11
+
12
+
[astring]: http://erratique.ch/software/astring
13
+
14
+
Home page: http://erratique.ch/software/fpath"""
15
+
maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
16
+
authors: "The fpath programmers"
17
+
license: "ISC"
18
+
tags: ["file" "system" "path" "org:erratique"]
19
+
homepage: "https://erratique.ch/software/fpath"
20
+
doc: "https://erratique.ch/software/fpath/doc/"
21
+
bug-reports: "https://github.com/dbuenzli/fpath/issues"
22
+
depends: [
23
+
"ocaml" {>= "4.08.0"}
24
+
"ocamlfind" {build}
25
+
"ocamlbuild" {build}
26
+
"topkg" {build & >= "1.1.0"}
27
+
]
28
+
build: ["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]
29
+
dev-repo: "git+https://erratique.ch/repos/fpath.git"
+20
vendor/opam/fpath/pkg/META
+20
vendor/opam/fpath/pkg/META
···
1
+
description = "File system paths for OCaml"
2
+
version = "%%VERSION_NUM%%"
3
+
requires = "astring"
4
+
archive(byte) = "fpath.cma"
5
+
archive(native) = "fpath.cmxa"
6
+
plugin(byte) = "fpath.cma"
7
+
plugin(native) = "fpath.cmxs"
8
+
exists_if = "fpath.cma fpath.cmxa"
9
+
10
+
package "top" (
11
+
directory = "top"
12
+
description = "The fpath.top library"
13
+
version = "%%VERSION_NUM%%"
14
+
requires = "fpath"
15
+
archive(byte) = "fpath_top.cma"
16
+
archive(native) = "fpath_top.cmxa"
17
+
plugin(byte) = "fpath_top.cma"
18
+
plugin(native) = "fpath_top.cmxs"
19
+
exists_if = "fpath_top.cma fpath_top.cmxa"
20
+
)
+10
vendor/opam/fpath/pkg/pkg.ml
+10
vendor/opam/fpath/pkg/pkg.ml
+6
vendor/opam/fpath/src/dune
+6
vendor/opam/fpath/src/dune
+768
vendor/opam/fpath/src/fpath.ml
+768
vendor/opam/fpath/src/fpath.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The fpath programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Astring
7
+
8
+
(* Unsafe string and byte manipulations. If you don't believe the
9
+
author's invariants, replacing with safe versions makes everything
10
+
safe in the library. He won't be upset. *)
11
+
12
+
let bytes_unsafe_set = Bytes.unsafe_set
13
+
let string_unsafe_get = String.unsafe_get
14
+
15
+
(* Errors *)
16
+
17
+
let err_invalid_seg s = strf "%a: invalid segment" String.dump s
18
+
let err_invalid_ext s = strf "%a: invalid extension" String.dump s
19
+
20
+
(* A few useful constants *)
21
+
22
+
let windows = Sys.os_type = "Win32"
23
+
let dir_sep_char = if windows then '\\' else '/'
24
+
let dir_sep = String.of_char dir_sep_char
25
+
let dir_sep_sub = String.sub dir_sep
26
+
let not_dir_sep c = c <> dir_sep_char
27
+
28
+
let dot = "."
29
+
let dot_dir = dot ^ dir_sep
30
+
let dot_dir_sub = String.sub dot_dir
31
+
let dotdot = ".."
32
+
let dotdot_dir = dotdot ^ dir_sep
33
+
let dotdot_dir_sub = String.sub dotdot_dir
34
+
35
+
(* Platform specific preliminaties *)
36
+
37
+
module Windows = struct
38
+
39
+
let is_unc_path p = String.is_prefix ~affix:"\\\\" p
40
+
let has_drive p = String.exists (Char.equal ':') p
41
+
let non_unc_path_start p = match String.find (Char.equal ':') p with
42
+
| None -> 0
43
+
| Some i -> i + 1 (* exists by construction *)
44
+
45
+
let parse_unc s =
46
+
(* parses an UNC path, the \\ prefix was already parsed, adds a root path
47
+
if there's only a volume, UNC paths are always absolute. *)
48
+
let p = String.sub ~start:2 s in
49
+
let not_bslash c = c <> '\\' in
50
+
let parse_seg p = String.Sub.span ~min:1 ~sat:not_bslash p in
51
+
let ensure_root r = Some (if String.Sub.is_empty r then (s ^ "\\") else s)
52
+
in
53
+
match parse_seg p with
54
+
| (seg1, _) when String.Sub.is_empty seg1 -> None (* \\ or \\\ *)
55
+
| (seg1, rest) ->
56
+
let seg1_len = String.Sub.length seg1 in
57
+
match String.Sub.get_head ~rev:true seg1 with
58
+
| '.' when seg1_len = 1 -> (* \\.\device\ *)
59
+
begin match parse_seg (String.Sub.tail rest) with
60
+
| (seg, _) when String.Sub.is_empty seg -> None
61
+
| (_, rest) -> ensure_root rest
62
+
end
63
+
| '?' when seg1_len = 1 ->
64
+
begin match parse_seg (String.Sub.tail rest) with
65
+
| (seg2, _) when String.Sub.is_empty seg2 -> None
66
+
| (seg2, rest) ->
67
+
if (String.Sub.get_head ~rev:true seg2 = ':') (* \\?\drive:\ *)
68
+
then (ensure_root rest) else
69
+
if not (String.Sub.equal_bytes seg2 (String.sub "UNC"))
70
+
then begin (* \\?\server\share\ *)
71
+
match parse_seg (String.Sub.tail rest) with
72
+
| (seg, _) when String.Sub.is_empty seg -> None
73
+
| (_, rest) -> ensure_root rest
74
+
end else begin (* \\?\UNC\server\share\ *)
75
+
match parse_seg (String.Sub.tail rest) with
76
+
| (seg, _) when String.Sub.is_empty seg -> None
77
+
| (_, rest) ->
78
+
match parse_seg (String.Sub.tail rest) with
79
+
| (seg, _) when String.Sub.is_empty seg -> None
80
+
| (_, rest) -> ensure_root rest
81
+
end
82
+
end
83
+
| _ -> (* \\server\share\ *)
84
+
begin match parse_seg (String.Sub.tail rest) with
85
+
| (seg, _) when String.Sub.is_empty seg -> None
86
+
| (_, rest) -> ensure_root rest
87
+
end
88
+
89
+
let sub_split_volume p =
90
+
(* splits a windows path into its volume (or drive) and actual file
91
+
path. When called the path in [p] is guaranteed to be non empty
92
+
and if [p] is an UNC path it is guaranteed to the be parseable by
93
+
parse_unc_windows. *)
94
+
let split_before i = String.sub p ~stop:i, String.sub p ~start:i in
95
+
if not (is_unc_path p) then
96
+
begin match String.find (Char.equal ':') p with
97
+
| None -> String.Sub.empty, String.sub p
98
+
| Some i -> split_before (i + 1)
99
+
end
100
+
else
101
+
let bslash ~start = match String.find ~start (Char.equal '\\') p with
102
+
| None -> assert false | Some i -> i
103
+
in
104
+
let i = bslash ~start:2 in
105
+
let j = bslash ~start:(i + 1) in
106
+
match p.[i-1] with
107
+
| '.' when i = 3 -> split_before j
108
+
| '?' when i = 3 ->
109
+
if p.[j-1] = ':' then split_before j else
110
+
if (String.Sub.equal_bytes
111
+
(String.sub p ~start:(i + 1) ~stop:j)
112
+
(String.sub "UNC"))
113
+
then split_before (bslash ~start:((bslash ~start:(j + 1)) + 1))
114
+
else split_before (bslash ~start:(j + 1))
115
+
| _ -> split_before j
116
+
117
+
let is_root p =
118
+
let _, path = sub_split_volume p in
119
+
String.Sub.length path = 1 && String.Sub.get path 0 = dir_sep_char
120
+
end
121
+
122
+
module Posix = struct
123
+
let has_volume p = String.is_prefix ~affix:"//" p
124
+
let is_root p = String.equal p dir_sep || String.equal p "//"
125
+
end
126
+
127
+
(* Segments *)
128
+
129
+
let is_seg_windows s =
130
+
let valid c = c <> '\x00' && c <> dir_sep_char && c <> '/' in
131
+
String.for_all valid s
132
+
133
+
let is_seg_posix s =
134
+
let valid c = c <> '\x00' && c <> dir_sep_char in
135
+
String.for_all valid s
136
+
137
+
let is_seg = if windows then is_seg_windows else is_seg_posix
138
+
139
+
let _split_last_seg p = String.Sub.span ~rev:true ~sat:not_dir_sep p
140
+
let _sub_last_seg p = String.Sub.take ~rev:true ~sat:not_dir_sep p
141
+
let _sub_last_non_empty_seg p = (* returns empty on roots though *)
142
+
let dir, last = _split_last_seg p in
143
+
match String.Sub.is_empty last with
144
+
| false -> last
145
+
| true -> _sub_last_seg (String.Sub.tail ~rev:true dir)
146
+
147
+
let _split_last_non_empty_seg p =
148
+
let (dir, last_seg as r) = _split_last_seg p in
149
+
match String.Sub.is_empty last_seg with
150
+
| false -> r, true
151
+
| true -> _split_last_seg (String.Sub.tail ~rev:true dir), false
152
+
153
+
let sub_last_seg_windows p = _sub_last_seg (snd (Windows.sub_split_volume p))
154
+
let sub_last_seg_posix p = _sub_last_seg (String.sub p)
155
+
let sub_last_seg = if windows then sub_last_seg_windows else sub_last_seg_posix
156
+
157
+
let sub_last_non_empty_seg_windows p =
158
+
_sub_last_non_empty_seg (snd (Windows.sub_split_volume p))
159
+
160
+
let sub_last_non_empty_seg_posix p =
161
+
_sub_last_non_empty_seg (String.sub p)
162
+
163
+
let sub_last_non_empty_seg =
164
+
if windows then sub_last_non_empty_seg_windows else
165
+
sub_last_non_empty_seg_posix
166
+
167
+
let is_rel_seg = function "." | ".." -> true | _ -> false
168
+
169
+
let sub_is_rel_seg seg = match String.Sub.length seg with
170
+
| 1 when String.Sub.get seg 0 = '.' -> true
171
+
| 2 when String.Sub.get seg 0 = '.' && String.Sub.get seg 1 = '.' -> true
172
+
| _ -> false
173
+
174
+
let sub_is_dir_seg seg = match String.Sub.length seg with
175
+
| 0 -> true
176
+
| 1 when String.Sub.get seg 0 = '.' -> true
177
+
| 2 when String.Sub.get seg 0 = '.' && String.Sub.get seg 1 = '.' -> true
178
+
| _ -> false
179
+
180
+
let segs_of_path p = String.cuts ~sep:dir_sep p
181
+
let segs_to_path segs = String.concat ~sep:dir_sep segs
182
+
183
+
(* File paths *)
184
+
185
+
type t = string (* N.B. a path is never "" or something is wrooong. *)
186
+
187
+
let err s = Error (`Msg (strf "%a: invalid path" String.dump s))
188
+
189
+
let validate_and_collapse_seps p =
190
+
(* collapse non-initial sequences of [dir_sep] to a single one and checks
191
+
no null byte *)
192
+
let max_idx = String.length p - 1 in
193
+
let rec with_buf b last_sep k i = (* k is the write index in b *)
194
+
if i > max_idx then Ok (Bytes.sub_string b 0 k) else
195
+
let c = string_unsafe_get p i in
196
+
if c = '\x00' then err p else
197
+
if c <> dir_sep_char
198
+
then (bytes_unsafe_set b k c; with_buf b false (k + 1) (i + 1)) else
199
+
if not last_sep
200
+
then (bytes_unsafe_set b k c; with_buf b true (k + 1) (i + 1)) else
201
+
with_buf b true k (i + 1)
202
+
in
203
+
let rec try_no_alloc last_sep i =
204
+
if i > max_idx then Ok p else
205
+
let c = string_unsafe_get p i in
206
+
if c = '\x00' then err p else
207
+
if c <> dir_sep_char then try_no_alloc false (i + 1) else
208
+
if not last_sep then try_no_alloc true (i + 1) else
209
+
let b = Bytes.of_string p in (* copy and overwrite starting from i *)
210
+
with_buf b true i (i + 1)
211
+
in
212
+
let start = (* Allow initial double sep for POSIX and UNC paths *)
213
+
if max_idx > 0 then (if p.[0] = dir_sep_char then 1 else 0) else 0
214
+
in
215
+
try_no_alloc false start
216
+
217
+
let of_string_windows s =
218
+
if s = "" then err s else
219
+
let p = String.map (fun c -> if c = '/' then '\\' else c) s in
220
+
match validate_and_collapse_seps p with
221
+
| Error _ as e -> e
222
+
| Ok p as some ->
223
+
if Windows.is_unc_path p then
224
+
(match Windows.parse_unc p with None -> err s | Some p -> Ok p)
225
+
else
226
+
match String.find (Char.equal ':') p with
227
+
| None -> some
228
+
| Some i when i = String.length p - 1 -> err p (* path is empty *)
229
+
| Some _ -> Ok p
230
+
231
+
let of_string_posix p = if p = "" then err p else validate_and_collapse_seps p
232
+
let of_string = if windows then of_string_windows else of_string_posix
233
+
234
+
let v s = match of_string s with
235
+
| Ok p -> p
236
+
| Error (`Msg m) -> invalid_arg m
237
+
238
+
let add_seg p seg =
239
+
if not (is_seg seg) then invalid_arg (err_invalid_seg seg);
240
+
let sep = if p.[String.length p - 1] = dir_sep_char then "" else dir_sep in
241
+
String.concat ~sep [p; seg]
242
+
243
+
let append_posix p0 p1 =
244
+
if p1.[0] = dir_sep_char (* absolute *) then p1 else
245
+
let sep = if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep in
246
+
String.concat ~sep [p0; p1]
247
+
248
+
let append_windows p0 p1 =
249
+
if Windows.is_unc_path p1 || Windows.has_drive p1 then p1 else
250
+
if p1.[0] = dir_sep_char then (* absolute *) p1 else
251
+
let sep = if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep in
252
+
String.concat ~sep [p0; p1]
253
+
254
+
let append = if windows then append_windows else append_posix
255
+
256
+
let ( / ) = add_seg
257
+
let ( // ) = append
258
+
259
+
let split_volume_windows p =
260
+
let vol, path = Windows.sub_split_volume p in
261
+
String.Sub.to_string vol, String.Sub.to_string path
262
+
263
+
let split_volume_posix p =
264
+
if Posix.has_volume p then dir_sep, String.with_range ~first:1 p else "", p
265
+
266
+
let split_volume = if windows then split_volume_windows else split_volume_posix
267
+
268
+
let segs_windows p =
269
+
let _, path = Windows.sub_split_volume p in
270
+
segs_of_path (String.Sub.to_string path)
271
+
272
+
let segs_posix p =
273
+
let segs = segs_of_path p in
274
+
if Posix.has_volume p then List.tl segs else segs
275
+
276
+
let segs = if windows then segs_windows else segs_posix
277
+
278
+
(* File and directory paths *)
279
+
280
+
let is_dir_path p = sub_is_dir_seg (sub_last_seg p)
281
+
let is_file_path p = not (is_dir_path p)
282
+
let to_dir_path p = add_seg p ""
283
+
284
+
let filename p = match String.Sub.to_string (sub_last_seg p) with
285
+
| "" | "." | ".." -> ""
286
+
| filename -> filename
287
+
288
+
(* Base and parent paths *)
289
+
290
+
let sub_is_root p = String.Sub.length p = 1 && String.Sub.get p 0 = dir_sep_char
291
+
292
+
let _split_base p =
293
+
let dir, last_seg = _split_last_seg p in
294
+
match String.Sub.is_empty dir with
295
+
| true -> (* single seg *) dot_dir_sub, String.Sub.to_string p
296
+
| false ->
297
+
match String.Sub.is_empty last_seg with
298
+
| false -> dir, String.Sub.to_string last_seg
299
+
| true ->
300
+
let dir_file = String.Sub.tail ~rev:true dir in
301
+
let dir, dir_last_seg = _split_last_seg dir_file in
302
+
match String.Sub.is_empty dir with
303
+
| true -> dot_dir_sub, String.Sub.to_string p
304
+
| false -> dir, String.Sub.(to_string (extend dir_last_seg))
305
+
306
+
let split_base_windows p =
307
+
let vol, path = Windows.sub_split_volume p in
308
+
if sub_is_root path then p, dot_dir else
309
+
let dir, b = _split_base path in
310
+
String.Sub.(base_string (append vol dir)), b
311
+
312
+
let split_base_posix p =
313
+
if Posix.is_root p then p, dot_dir else
314
+
let dir, b = _split_base (String.sub p) in
315
+
String.Sub.to_string dir, b
316
+
317
+
let split_base = if windows then split_base_windows else split_base_posix
318
+
319
+
let base p = snd (split_base p)
320
+
321
+
let _basename p = match String.Sub.to_string (_sub_last_non_empty_seg p) with
322
+
| "." | ".." -> ""
323
+
| basename -> basename
324
+
325
+
let basename_windows p =
326
+
let vol, path = Windows.sub_split_volume p in
327
+
if sub_is_root path then "" else _basename path
328
+
329
+
let basename_posix p = if Posix.is_root p then "" else _basename (String.sub p)
330
+
let basename p = if windows then basename_windows p else basename_posix p
331
+
332
+
let _parent p =
333
+
(* The parent algorithm is not very smart. It tries to preserve the
334
+
original path and avoids dealing with normalization. We simply
335
+
only keep everything before the last non-empty, non-relative,
336
+
path segment and if the resulting path is empty we return
337
+
"./". Otherwise if the last non-empty segment is "." or ".." we
338
+
simply postfix with "../" *)
339
+
let (dir, seg), is_last = _split_last_non_empty_seg p in
340
+
let dsep = if is_last then dir_sep_sub else String.Sub.empty in
341
+
if sub_is_rel_seg seg then [p; dsep; dotdot_dir_sub] else
342
+
if String.Sub.is_empty dir then [dot_dir_sub] else [dir]
343
+
344
+
let parent_windows p =
345
+
let vol, path = Windows.sub_split_volume p in
346
+
if sub_is_root path then p else
347
+
String.Sub.(base_string @@ concat (vol :: _parent path))
348
+
349
+
let parent_posix p =
350
+
if Posix.is_root p then p else
351
+
String.Sub.(base_string @@ concat (_parent (String.sub p)))
352
+
353
+
let parent = if windows then parent_windows else parent_posix
354
+
355
+
(* Normalization *)
356
+
357
+
let rem_empty_seg_windows p =
358
+
let vol, path = Windows.sub_split_volume p in
359
+
if sub_is_root path then p else
360
+
let max = String.Sub.stop_pos path - 1 in
361
+
if String.get p max <> dir_sep_char then p else
362
+
String.with_index_range p ~last:(max - 1)
363
+
364
+
let rem_empty_seg_posix p = match String.length p with
365
+
| 1 -> p
366
+
| 2 ->
367
+
if p.[0] <> dir_sep_char && p.[1] = dir_sep_char
368
+
then String.of_char p.[0]
369
+
else p
370
+
| len ->
371
+
let max = len - 1 in
372
+
if p.[max] <> dir_sep_char then p else
373
+
String.with_index_range p ~last:(max - 1)
374
+
375
+
let rem_empty_seg =
376
+
if windows then rem_empty_seg_windows else rem_empty_seg_posix
377
+
378
+
let normalize_rel_segs segs = (* result is non empty but may be [""] *)
379
+
let rec loop acc = function
380
+
| "." :: [] -> ("" :: acc) (* final "." remove but preserve directoryness. *)
381
+
| "." :: rest -> loop acc rest
382
+
| ".." :: rest ->
383
+
begin match acc with
384
+
| ".." :: _ | [] -> loop (".." :: acc) rest
385
+
| seg :: acc -> (* N.B. seg can't be "." *)
386
+
match rest with
387
+
| [] -> ("" :: acc) (* preserve directoryness *)
388
+
| rest -> loop acc rest
389
+
end
390
+
| seg :: rest -> loop (seg :: acc) rest
391
+
| [] ->
392
+
match acc with
393
+
| ".." :: _ -> ("" :: acc) (* normalize final .. to ../ *)
394
+
| [] -> [""]
395
+
| acc -> acc
396
+
in
397
+
List.rev (loop [] segs)
398
+
399
+
let normalize_segs = function
400
+
| "" :: segs -> (* absolute path *)
401
+
let rec rem_dotdots = function ".." :: ss -> rem_dotdots ss | ss -> ss in
402
+
"" :: (rem_dotdots @@ normalize_rel_segs segs)
403
+
| segs ->
404
+
match normalize_rel_segs segs with
405
+
| [""] -> ["."; ""]
406
+
| segs -> segs
407
+
408
+
let normalize_windows p =
409
+
let vol, path = Windows.sub_split_volume p in
410
+
let path = String.Sub.to_string path in
411
+
let path = segs_to_path @@ normalize_segs (segs_of_path path) in
412
+
String.Sub.(to_string (concat [vol; String.sub path]))
413
+
414
+
let normalize_posix p =
415
+
let has_volume = Posix.has_volume p in
416
+
let segs = segs_of_path p in
417
+
let segs = normalize_segs @@ if has_volume then List.tl segs else segs in
418
+
let segs = if has_volume then "" :: segs else segs in
419
+
segs_to_path segs
420
+
421
+
let normalize = if windows then normalize_windows else normalize_posix
422
+
423
+
(* Prefixes *)
424
+
425
+
let is_prefix prefix p =
426
+
if not (String.is_prefix ~affix:prefix p) then false else
427
+
(* Further check the prefix is segment-based. If [prefix] ends with a
428
+
dir_sep_char nothing more needs to be checked. If it doesn't we need
429
+
to check that [p]'s remaining suffix is either empty or
430
+
starts with a directory separator. *)
431
+
let suff_start = String.length prefix in
432
+
if prefix.[suff_start - 1] = dir_sep_char then true else
433
+
if suff_start = String.length p then (* suffix empty *) true else
434
+
p.[suff_start] = dir_sep_char
435
+
436
+
let _prefix_last_index p0 p1 = (* last char index of segment-based prefix *)
437
+
let l0 = String.length p0 in
438
+
let l1 = String.length p1 in
439
+
let p0, p1, max = if l0 < l1 then p0, p1, l0 - 1 else p1, p0, l1 - 1 in
440
+
let rec loop last_dir_sep i p0 p1 = match i > max || p0.[i] <> p1.[i] with
441
+
| false ->
442
+
let last_dir_sep = if p0.[i] = dir_sep_char then i else last_dir_sep in
443
+
loop last_dir_sep (i + 1) p0 p1
444
+
| true ->
445
+
if i = 0 then None else
446
+
let last = i - 1 in
447
+
if last_dir_sep = last then Some last else
448
+
match last = max with
449
+
| true ->
450
+
if l1 = l0 then Some last else
451
+
if p1.[i] = dir_sep_char then Some last else
452
+
if last_dir_sep <> -1 then Some last_dir_sep else None
453
+
| false ->
454
+
if last_dir_sep <> -1 then Some last_dir_sep else None
455
+
in
456
+
loop (-1) 0 p0 p1
457
+
458
+
let find_prefix_windows p0 p1 = match _prefix_last_index p0 p1 with
459
+
| None -> None
460
+
| Some i ->
461
+
let v0_len = String.Sub.length (fst (Windows.sub_split_volume p0)) in
462
+
let v1_len = String.Sub.length (fst (Windows.sub_split_volume p1)) in
463
+
let max_vlen = if v0_len > v1_len then v0_len else v1_len in
464
+
if i < max_vlen then None else Some (String.with_index_range p0 ~last:i)
465
+
466
+
let find_prefix_posix p0 p1 = match _prefix_last_index p0 p1 with
467
+
| None -> None
468
+
| Some 0 when Posix.has_volume p0 || Posix.has_volume p1 -> None
469
+
| Some i -> Some (String.with_index_range p0 ~last:i)
470
+
471
+
let find_prefix = if windows then find_prefix_windows else find_prefix_posix
472
+
473
+
let rem_prefix prefix p = match is_prefix prefix p with
474
+
| false -> None
475
+
| true ->
476
+
match String.length prefix with
477
+
| len when len = String.length p -> None
478
+
| len ->
479
+
let first = if p.[len] = dir_sep_char then len + 1 else len in
480
+
match String.with_index_range p ~first with
481
+
| "" -> Some dot_dir
482
+
| q -> Some q
483
+
484
+
(* Roots and relativization *)
485
+
486
+
let _relativize ~root p =
487
+
if String.equal root p
488
+
then Some (segs_to_path (if is_dir_path p then ["."; ""] else ["."])) else
489
+
let root = (* root is always interpreted as a directory *)
490
+
let root = normalize root in
491
+
if root.[String.length root - 1] = dir_sep_char then root else
492
+
root ^ dir_sep
493
+
in
494
+
let p = normalize p in
495
+
let rec walk root p = match root, p with
496
+
| (".." :: _, s :: _) when s <> ".." ->
497
+
(* [root] has too many up segments. Cannot walk down to express [p],
498
+
e.g. "../a" can't be expressed relative to "../../". *)
499
+
None
500
+
| (sr :: root, sp :: (_ :: _ as p)) when sr = sp ->
501
+
(* the next directory in [root] and [p] match and it's not the last
502
+
segment of [p], walk to next segment *)
503
+
walk root p
504
+
| [""], [""] ->
505
+
(* walk ends at the end of both path simultaneously, [p] is a
506
+
directory that matches exactly [root] interpreted as a directory. *)
507
+
Some (segs_to_path ["."; ""])
508
+
| root, p ->
509
+
(* walk ends here, either the next directory is different in
510
+
[root] and [p] or it is equal but it is the last one for [p]
511
+
and different from [""] (i.e. [p] is a file path and prefix
512
+
of [root]). To get to the current position from the remaining
513
+
root we need to go up the number of non-empty segments that
514
+
remain in [root] (length root - 1). To get to the path [p]
515
+
from the current position we just use [p] so prepending
516
+
length root - 1 ".." segments to [p] tells us how to go from
517
+
the remaining root to [p]. *)
518
+
let segs = List.fold_left (fun acc _ -> dotdot :: acc) p (List.tl root) in
519
+
Some (segs_to_path segs)
520
+
in
521
+
match segs root, segs p with
522
+
| ("" :: _, s :: _) when s <> "" -> None (* absolute/relative mismatch *)
523
+
| (s :: _, "" :: _) when s <> "" -> None (* absolute/relative mismatch *)
524
+
| ["."; ""], p ->
525
+
(* p is relative and must be expressed w.r.t. "./", so it is itself. *)
526
+
Some (segs_to_path p)
527
+
| root, p ->
528
+
(* walk in the segments of root and p until a segment mismatches.
529
+
at that point express the remaining p relative to the remaining
530
+
root. Note that because of normalization both [root] and [p] may
531
+
only have initial .. segments and [root] by construction has a
532
+
final "" segment. *)
533
+
walk root p
534
+
535
+
let relativize_windows ~root p =
536
+
let rvol, root = Windows.sub_split_volume root in
537
+
let pvol, p = Windows.sub_split_volume p in
538
+
if not (String.Sub.equal_bytes rvol pvol) then None else
539
+
let root = String.Sub.to_string root in
540
+
let p = String.Sub.to_string p in
541
+
_relativize ~root p
542
+
543
+
let relativize_posix ~root p = _relativize ~root p
544
+
545
+
let relativize = if windows then relativize_windows else relativize_posix
546
+
547
+
let is_rooted ~root p = match relativize ~root p with
548
+
| None -> false
549
+
| Some r ->
550
+
not (String.equal dotdot r || String.is_prefix ~affix:dotdot_dir r ||
551
+
(String.equal root p && not (is_dir_path p)))
552
+
553
+
(* Predicates and comparison *)
554
+
555
+
let is_rel_posix p = p.[0] <> dir_sep_char
556
+
let is_rel_windows p =
557
+
if Windows.is_unc_path p then false else
558
+
p.[Windows.non_unc_path_start p] <> dir_sep_char
559
+
560
+
let is_rel = if windows then is_rel_windows else is_rel_posix
561
+
let is_abs p = not (is_rel p)
562
+
let is_root = if windows then Windows.is_root else Posix.is_root
563
+
564
+
let is_current_dir_posix ?(prefix = false) p = match prefix with
565
+
| false -> String.equal dot p || String.equal dot_dir p
566
+
| true -> String.equal dot p || String.is_prefix ~affix:dot_dir p
567
+
568
+
let is_current_dir_windows ?(prefix = false) p =
569
+
if Windows.is_unc_path p then false else
570
+
let start = Windows.non_unc_path_start p in
571
+
match String.length p - start with
572
+
| 1 -> p.[start] = '.'
573
+
| n when n = 2 || prefix -> p.[start] = '.' && p.[start + 1] = dir_sep_char
574
+
| _ -> false
575
+
576
+
let is_current_dir =
577
+
if windows then is_current_dir_windows else is_current_dir_posix
578
+
579
+
let is_parent_dir_posix ?(prefix = false) p = match prefix with
580
+
| false -> String.equal dotdot p || String.equal dotdot_dir p
581
+
| true -> String.equal dotdot p || String.is_prefix ~affix:dotdot_dir p
582
+
583
+
let is_parent_dir_windows ?(prefix = false) p =
584
+
if Windows.is_unc_path p then false else
585
+
let start = Windows.non_unc_path_start p in
586
+
match String.length p - start with
587
+
| 1 -> false
588
+
| 2 -> p.[start] = '.' && p.[start + 1] = '.'
589
+
| n when n = 3 || prefix ->
590
+
p.[start] = '.' && p.[start + 1] = '.' && p.[start + 2] = dir_sep_char
591
+
| _ -> false
592
+
593
+
let is_parent_dir =
594
+
if windows then is_parent_dir_windows else is_parent_dir_posix
595
+
596
+
let is_dotfile p = match basename p with | "" -> false | s -> s.[0] = '.'
597
+
598
+
let equal = String.equal
599
+
let compare = String.compare
600
+
601
+
(* Conversions and pretty printing *)
602
+
603
+
let to_string p = p
604
+
let pp ppf p = Format.pp_print_string ppf (to_string p)
605
+
let dump ppf p = String.dump ppf (to_string p)
606
+
607
+
(* File extensions *)
608
+
609
+
type ext = string
610
+
611
+
let ext_sep_char = '.'
612
+
let ext_sep = String.of_char ext_sep_char
613
+
let ext_sep_sub = String.Sub.of_char ext_sep_char
614
+
let eq_ext_sep c = c = ext_sep_char
615
+
let neq_ext_sep c = c <> ext_sep_char
616
+
617
+
let rec sub_multi_ext seg =
618
+
let first_not_sep = String.Sub.drop ~sat:eq_ext_sep seg in
619
+
String.Sub.drop ~sat:neq_ext_sep first_not_sep
620
+
621
+
let sub_single_ext seg =
622
+
let name_dot, ext = String.Sub.span ~rev:true ~sat:neq_ext_sep seg in
623
+
if String.Sub.exists neq_ext_sep name_dot
624
+
then String.Sub.extend ~max:1 ~rev:true ext
625
+
else String.Sub.empty
626
+
627
+
let sub_ext ?(multi = false) seg =
628
+
if multi then sub_multi_ext seg else sub_single_ext seg
629
+
630
+
let sub_get_ext ?multi p = sub_ext ?multi (sub_last_non_empty_seg p)
631
+
let get_ext ?multi p = String.Sub.to_string (sub_get_ext ?multi p)
632
+
633
+
let has_ext e p =
634
+
let ext = sub_get_ext ~multi:true p in
635
+
if String.Sub.is_empty ext then false else
636
+
if not (String.(Sub.is_suffix ~affix:(sub e) ext)) then false else
637
+
if not (String.is_empty e) && e.[0] = ext_sep_char then true else
638
+
(* Check there's a dot before the suffix [e] in [ext] *)
639
+
let dot_index = String.Sub.length ext - String.length e - 1 in
640
+
String.Sub.get ext dot_index = ext_sep_char
641
+
642
+
let mem_ext exts p = List.exists (fun ext -> has_ext ext p) exts
643
+
644
+
let exists_ext ?(multi = false) p =
645
+
let ext = sub_get_ext ~multi p in
646
+
if multi then String.Sub.exists eq_ext_sep (String.Sub.tail ext) else
647
+
not (String.Sub.is_empty ext)
648
+
649
+
let add_ext e p =
650
+
if String.is_empty e then p else
651
+
if not (is_seg e) then invalid_arg (err_invalid_ext e) else
652
+
let seg = sub_last_non_empty_seg p in
653
+
if sub_is_dir_seg seg then p else
654
+
let e_has_dot = e.[0] = ext_sep_char in
655
+
let maybe_dot = if e_has_dot then String.Sub.empty else ext_sep_sub in
656
+
let has_empty = p.[String.length p - 1] = dir_sep_char in
657
+
let maybe_empty = if has_empty then dir_sep_sub else String.Sub.empty in
658
+
let seg_end = String.Sub.stop_pos seg - 1 in
659
+
let prefix = String.sub_with_index_range ~last:seg_end p in
660
+
let path = [prefix; maybe_dot; String.sub e; maybe_empty] in
661
+
String.Sub.(base_string (concat path))
662
+
663
+
let _split_ext ?multi p =
664
+
let ext = sub_get_ext ?multi p in
665
+
if String.Sub.is_empty ext then p, ext else
666
+
let before_ext = String.Sub.start_pos ext - 1 in
667
+
if String.Sub.stop_pos ext = String.length p
668
+
then String.with_index_range p ~last:before_ext, ext else
669
+
let prefix = String.sub_with_index_range p ~last:before_ext in
670
+
String.Sub.(base_string (concat [prefix; dir_sep_sub])), ext
671
+
672
+
let rem_ext ?multi p = fst (_split_ext ?multi p)
673
+
let set_ext ?multi e p = add_ext e (rem_ext ?multi p)
674
+
let split_ext ?multi p =
675
+
let p, ext = _split_ext ?multi p in
676
+
p, String.Sub.to_string ext
677
+
678
+
let ( + ) p e = add_ext e p
679
+
let ( -+ ) p e = set_ext e p
680
+
681
+
(* Path sets and maps *)
682
+
683
+
type path = t
684
+
685
+
module Set = struct
686
+
include Set.Make (String)
687
+
688
+
let pp ?sep:(pp_sep = Format.pp_print_cut) pp_elt ppf ps =
689
+
let pp_elt elt is_first =
690
+
if is_first then () else pp_sep ppf ();
691
+
Format.fprintf ppf "%a" pp_elt elt; false
692
+
in
693
+
ignore (fold pp_elt ps true)
694
+
695
+
let dump_path = dump
696
+
let dump ppf ss =
697
+
let pp_elt elt is_first =
698
+
if is_first then () else Format.fprintf ppf "@ ";
699
+
Format.fprintf ppf "%a" dump_path elt;
700
+
false
701
+
in
702
+
Format.fprintf ppf "@[<1>{";
703
+
ignore (fold pp_elt ss true);
704
+
Format.fprintf ppf "}@]";
705
+
()
706
+
707
+
let err_empty () = invalid_arg "empty set"
708
+
let err_absent p ps =
709
+
invalid_arg (strf "%a not in set %a" dump_path p dump ps)
710
+
711
+
let get_min_elt ps = try min_elt ps with Not_found -> err_empty ()
712
+
let min_elt ps = try Some (min_elt ps) with Not_found -> None
713
+
714
+
let get_max_elt ps = try max_elt ps with Not_found -> err_empty ()
715
+
let max_elt ps = try Some (max_elt ps) with Not_found -> None
716
+
717
+
let get_any_elt ps = try choose ps with Not_found -> err_empty ()
718
+
let choose ps = try Some (choose ps) with Not_found -> None
719
+
720
+
let get p ps = try find p ps with Not_found -> err_absent p ps
721
+
let find p ps = try Some (find p ps) with Not_found -> None
722
+
723
+
let of_list = List.fold_left (fun acc s -> add s acc) empty
724
+
end
725
+
726
+
module Map = struct
727
+
include Map.Make (String)
728
+
729
+
let err_empty () = invalid_arg "empty map"
730
+
let err_absent s = invalid_arg (strf "%s is not bound in map" s)
731
+
732
+
let get_min_binding m = try min_binding m with Not_found -> err_empty ()
733
+
let min_binding m = try Some (min_binding m) with Not_found -> None
734
+
735
+
let get_max_binding m = try max_binding m with Not_found -> err_empty ()
736
+
let max_binding m = try Some (max_binding m) with Not_found -> None
737
+
738
+
let get_any_binding m = try choose m with Not_found -> err_empty ()
739
+
let choose m = try Some (choose m) with Not_found -> None
740
+
741
+
let get k s = try find k s with Not_found -> err_absent k
742
+
let find k m = try Some (find k m) with Not_found -> None
743
+
744
+
let dom m = fold (fun k _ acc -> Set.add k acc) m Set.empty
745
+
746
+
let of_list bs = List.fold_left (fun m (k,v) -> add k v m) empty bs
747
+
748
+
let pp ?sep:(pp_sep = Format.pp_print_cut) pp_binding ppf (m : 'a t) =
749
+
let pp_binding k v is_first =
750
+
if is_first then () else pp_sep ppf ();
751
+
pp_binding ppf (k, v); false
752
+
in
753
+
ignore (fold pp_binding m true)
754
+
755
+
let dump pp_v ppf m =
756
+
let pp_binding k v is_first =
757
+
if is_first then () else Format.fprintf ppf "@ ";
758
+
Format.fprintf ppf "@[<1>(@[%a@],@ @[%a@])@]" dump k pp_v v;
759
+
false
760
+
in
761
+
Format.fprintf ppf "@[<1>{";
762
+
ignore (fold pp_binding m true);
763
+
Format.fprintf ppf "}@]";
764
+
()
765
+
end
766
+
767
+
type set = Set.t
768
+
type 'a map = 'a Map.t
+994
vendor/opam/fpath/src/fpath.mli
+994
vendor/opam/fpath/src/fpath.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2014 The fpath programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** File system paths, file {{!file_exts}extensions}, path {{!Set}sets}
7
+
and {{!Map}maps}.
8
+
9
+
A (file system) {e path} specifies a file or a directory in a file
10
+
system hierarchy. A path has three parts:
11
+
{ol
12
+
{- An optional, platform-dependent, {{!split_volume}volume}.}
13
+
{- An optional root directory separator {!dir_sep} whose presence
14
+
distinguishes {e absolute} paths (["/a"]) from {e relative}
15
+
ones (["a"])}
16
+
{- A non-empty list of {!dir_sep} separated segments. Segments are
17
+
non empty strings except for maybe the last one. The latter
18
+
distinguishes {e directory paths}
19
+
(["a/b/"]) from {e file paths} (["a/b"]).}}
20
+
21
+
The path segments ["."] and [".."] are {{!is_rel_seg}{e relative
22
+
path segments}} that respectively denote the current and parent
23
+
directory. The {{!basename}{e basename}} of a path is its last
24
+
non-empty segment if it is not a relative path segment or the empty
25
+
string otherwise.
26
+
27
+
Consult a few {{!tips}important tips}.
28
+
29
+
{b Note.} [Fpath] processes paths without accessing the file system. *)
30
+
31
+
(** {1:segs Separators and segments} *)
32
+
33
+
val dir_sep : string
34
+
(** [dir_sep] is the platform dependent natural directory separator. This is
35
+
["/"] on POSIX and ["\\"] on Windows. *)
36
+
37
+
val is_seg : string -> bool
38
+
(** [is_seg s] is [true] iff [s] does not contain {!dir_sep} or ['/'] or
39
+
a [0x00] byte. *)
40
+
41
+
val is_rel_seg : string -> bool
42
+
(** [is_rel_seg s] is true iff [s] is a relative segment, that is
43
+
["."] or [".."]. *)
44
+
45
+
(** {1:paths Paths} *)
46
+
47
+
type t
48
+
(** The type for paths. *)
49
+
50
+
val v : string -> t
51
+
(** [v s] is the string [s] as a path.
52
+
53
+
@raise Invalid_argument if [s] is not a {{!of_string}valid path}. Use
54
+
{!of_string} to deal with untrusted input. *)
55
+
56
+
val add_seg : t -> string -> t
57
+
(** [add_seg p seg] adds segment [seg] to the segments of [p] if
58
+
[p]'s last segment is non-empty or replaces the last empty
59
+
segment with [seg]. {{!ex_add_seg}Examples}.
60
+
61
+
@raise Invalid_argument if {!is_seg}[ seg] is [false]. *)
62
+
63
+
val ( / ) : t -> string -> t
64
+
(** [p / seg] is {!add_seg}[ p seg]. Left associative. *)
65
+
66
+
val append : t -> t -> t
67
+
(** [append p q] appends [q] to [p] as follows:
68
+
{ul
69
+
{- If [q] is absolute or has a non-empty {{!split_volume}volume} then
70
+
[q] is returned.}
71
+
{- Otherwise appends [q]'s segments to [p] using {!add_seg}.}}
72
+
{{!ex_append}Examples}. *)
73
+
74
+
val ( // ) : t -> t -> t
75
+
(** [p // p'] is {!append}[ p p']. Left associative. *)
76
+
77
+
val split_volume : t -> string * t
78
+
(** [split_volume p] is the pair [(vol, q)] where [vol] is
79
+
the platform dependent volume of [p] or the empty string
80
+
if there is none and [q] the path [p] without its volume, that is
81
+
its optional root {!dir_sep} and segments.
82
+
83
+
On POSIX if [vol] is non-empty then it
84
+
{{:http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap03.html#tag_03_267}can} only be ["/"] (e.g. in [v "//a/b"]). On Windows [vol] may be
85
+
one of the following prefixes parsed before an
86
+
absolute root {!dir_sep}, except in the first case
87
+
where a relative path can follow:
88
+
{[
89
+
$(drive):
90
+
\\$(server)\$(share)
91
+
\\?\$(drive):
92
+
\\?\$(server)\$(share)
93
+
\\?\UNC\$(server)\$(share)
94
+
\\.\$(device)
95
+
]}
96
+
The following invariant holds:
97
+
{ul
98
+
{- [equal p (v @@ vol ^ (to_string q))]}} *)
99
+
100
+
val segs : t -> string list
101
+
(** [segs p] is [p]'s {e non-empty} list of segments. Absolute paths have an
102
+
initial empty string added, this allows to recover the path's string with
103
+
{!String.concat}[ ~sep:dir_sep]. {{!ex_segs}Examples.}
104
+
105
+
The following invariant holds:
106
+
{ul
107
+
{- [equal p (v @@ (fst @@ split_volume p) ^ (String.concat ~sep:dir_sep
108
+
(segs p)))]}} *)
109
+
110
+
(** {1:filedir File and directory paths}
111
+
112
+
{b Note.} The following functions use syntactic semantic properties
113
+
of paths. Given a path, these properties can be different from the one
114
+
your file system attributes to it. *)
115
+
116
+
val is_dir_path : t -> bool
117
+
(** [is_dir_path p] is [true] iff [p] represents a directory. This
118
+
means that [p]'s last segment is either empty ([""]) or
119
+
{{!is_rel_seg}relative}. The property is invariant with respect
120
+
to {{!normalize}normalization}. {{!ex_is_dir_path}Examples}. *)
121
+
122
+
val is_file_path : t -> bool
123
+
(** [is_file_path p] is [true] iff [p] represents a file. This is the
124
+
negation of {!is_dir_path}. This means that [p]'s last segment is
125
+
neither empty ([""]) nor {{!is_rel_seg}relative}. The property is
126
+
invariant with respect to {{!normalize}normalization}.
127
+
{{!ex_is_file_path}Examples}. *)
128
+
129
+
val to_dir_path : t -> t
130
+
(** [to_dir_path p] is {!add_seg}[ p ""]. It ensure that the result
131
+
represents a {{!is_dir_path}directory} and, if converted to a
132
+
string, that it ends with a {!dir_sep}.
133
+
{{!ex_to_dir_path}Examples}. *)
134
+
135
+
val filename : t -> string
136
+
(** [filename p] is the file name of [p]. This is the last segment of
137
+
[p] if [p] is a {{!is_file_path}file path} and the empty string
138
+
otherwise. The result is invariant with respect to
139
+
{{!normalize}normalization}. See also
140
+
{!basename}. {{!ex_filename}Examples}. *)
141
+
142
+
(** {1:parentbase Base and parent paths} *)
143
+
144
+
val split_base : t -> t * t
145
+
(** [split_base p] splits [p] into a directory [d] and a {e relative}
146
+
base path [b] such that:
147
+
{ul
148
+
{- [b] is a relative path that contains the segments of [p]
149
+
that start at the last non-empty segment. This means
150
+
that [b] has a {e single} non-empty segment, and preserves
151
+
{{!is_dir_path}directoryness} of [p]. If [p] is a
152
+
{{!is_root}root path} there are no such segments and [b]
153
+
is ["./"].}
154
+
{- [d] is a {{!is_dir_path}directory} such that [d // b]
155
+
represents the same path as [p]. They may however differ
156
+
syntactically when converted to a string.}}
157
+
{{!ex_split_base}Examples}.
158
+
159
+
{b Note.} {{!normalize}Normalizing} [p] before using the function
160
+
ensures that [b] is a {{!is_rel_seg}relative segment} iff [p] cannot
161
+
be named (like in ["."], ["../../"], ["/"], etc.). *)
162
+
163
+
val base : t -> t
164
+
(** [base p] is [snd (split_base p)]. *)
165
+
166
+
val basename : t -> string
167
+
(** [basename p] is [p]'s last non-empty segment if non-relative or
168
+
the empty string otherwise. The latter occurs only on {{!is_root}root
169
+
paths} and on paths whose last non-empty segment is a
170
+
{{!is_rel_seg}relative segment}. See also {!filename} and
171
+
{!base}. {{!ex_basename}Examples}.
172
+
173
+
{b Note.} {{!normalize}Normalizing} [p] before using the function
174
+
ensures the empty string is only returned iff [p] cannot be
175
+
named (like in ["."], ["../../"], ["/"], etc.) *)
176
+
177
+
val parent : t -> t
178
+
(** [parent p] is a {{!is_dir_path}directory path} that contains [p].
179
+
If [p] is a {{!is_root}root path} this is [p] itself.
180
+
{{!ex_parent}Examples}.
181
+
182
+
{b Warning.} [parent p // base p] may not represent [p], use
183
+
{!split_base} for this. *)
184
+
185
+
(** {1:norm Normalization} *)
186
+
187
+
val rem_empty_seg : t -> t
188
+
(** [rem_empty_seg p] removes an existing last empty segment of [p] if [p]
189
+
is not a {{!is_root}root path}. This ensure that if [p] is
190
+
converted to a string it will not have a trailing {!dir_sep}
191
+
unless [p] is a root path. Note that this may affect [p]'s
192
+
{{!is_dir_path}directoryness}. {{!ex_rem_empty_seg}Examples}. *)
193
+
194
+
val normalize : t -> t
195
+
(** [normalize p] is a path that represents the same path as [p],
196
+
{{!is_dir_path}directoryness} included, and that has the following
197
+
properties:
198
+
{ul
199
+
{- If [p] is absolute the resulting path has no ["."] and [".."]
200
+
segments.}
201
+
{- If [p] is relative the resulting path is either ["./"] or
202
+
it has no ["."] segments and [".."] segments may only appear as
203
+
initial segments.}
204
+
{- If [p] is a {{!is_dir_path}directory} it always end with
205
+
an empty segment; this means it doesn't end with ["."] or [".."].}}
206
+
{{!ex_normalize}Examples}.
207
+
208
+
{b Warning.} Like file and directory path {{!filedir}functions}
209
+
this function does not consult the file system and is purely
210
+
based on the syntactic semantic of paths which can be different
211
+
from the one of your concrete file system attributes. For example in
212
+
presence of symbolic links the resulting path may not point to the same
213
+
entity. Use the normalization functions of your OS system library to
214
+
ensure correct behaviour with respect to a concrete file system. *)
215
+
216
+
(** {1:prefixes Prefixes}
217
+
218
+
{b Warning.} The syntactic {{!is_prefix}prefix relation} between
219
+
paths does not, in general, entail directory containement. The following
220
+
examples show this:
221
+
{[
222
+
is_prefix (v "..") (v "../..") = true
223
+
is_prefix (v "..") (v ".") = false
224
+
]}
225
+
However, on {{!normalize}normalized}, {{!is_abs}absolute} paths,
226
+
the prefix relation does entail directory containement. See also
227
+
{!is_rooted}. *)
228
+
229
+
val is_prefix : t -> t -> bool
230
+
(** [is_prefix prefix p] is [true] if [prefix] is a prefix of
231
+
[p]. This checks that:
232
+
{ul
233
+
{- [prefix] has the same optional volume as [p].}
234
+
{- [prefix] has the same optional root directory separator as [p].}
235
+
{- The list of segments of [prefix] is a prefix of those of
236
+
[p], ignoring the last empty segment of [prefix] if the number of
237
+
non-empty segments of [p] is strictly larger than those of [prefix].
238
+
This means that [is_prefix (v "a/") (v "a/b")] is [true] but
239
+
[is_prefix (v "a/") (v "a")] is [false]}}
240
+
{{!ex_is_prefix}Examples}. *)
241
+
242
+
val find_prefix : t -> t -> t option
243
+
(** [find_prefix p p'] is [Some prefix] if there exists [prefix] such
244
+
that [prefix] is the longest path with [is_prefix prefix p &&
245
+
is_prefix prefix p' = true] and [None] otherwise. Note that if
246
+
both [p] and [p'] are absolute and have the same volume then a
247
+
prefix always exists: the {{!is_root}root path} of their volume.
248
+
{{!ex_find_prefix}Examples}. *)
249
+
250
+
val rem_prefix : t -> t -> t option
251
+
(** [rem_prefix prefix p] is:
252
+
{ul
253
+
{- [None] if [prefix] is not a {{!is_prefix}prefix} of [p] or if [prefix]
254
+
and [p] are {{!equal}equal}.}
255
+
{- [Some q] otherwise where [q] is [p] without the
256
+
prefix [prefix] and preserves [p]'s
257
+
{{!is_dir_path}directoryness}. This means that [q] is a always
258
+
{{!is_rel}relative} and that the path [prefix // q] and [p] represent the
259
+
same paths. They may however differ syntactically when
260
+
converted to a string.}}
261
+
{{!ex_rem_prefix}Examples}. *)
262
+
263
+
(** {1:rootrel Roots and relativization} *)
264
+
265
+
val relativize : root:t -> t -> t option
266
+
(** [relativize ~root p] tries to express path [p] relative to the directory
267
+
[root]:
268
+
{ul
269
+
{- [Some q] if there exists a {{!is_rel}relative} path [q] such
270
+
that [root // q] and [p] represent the same paths,
271
+
{{!is_dir_path}directoryness} included. They may however differ
272
+
syntactically when converted to a string. Note that [q] is
273
+
{{!normalize}normalized}.}
274
+
{- [None] otherwise. This notably happens if [p] is absolute
275
+
and [root] relative or if [root] is relative and [p] is absolute.
276
+
In both cases it's not possible to know how to get from [p] from
277
+
[root].}}
278
+
{{!ex_relativize}Examples}. *)
279
+
280
+
val is_rooted : root:t -> t -> bool
281
+
(** [is_rooted root p] is [true] iff the path [p] is the
282
+
{{!is_dir_path}{e directory}} [root] or contained in [root] and that [p]
283
+
can be {{!relativize} relativized} w.r.t. [root] (the normalized relative
284
+
path will have no parent directory segments).
285
+
{{!ex_is_rooted}Examples}. *)
286
+
287
+
(** {1:predicates Predicates and comparison} *)
288
+
289
+
val is_rel : t -> bool
290
+
(** [is_rel p] is [true] iff [p] is a relative path, i.e. the root
291
+
directory separator is missing in [p]. *)
292
+
293
+
val is_abs : t -> bool
294
+
(** [is_abs p] is [true] iff [p] is an absolute path, i.e. the root
295
+
directory separator is present in [p]. *)
296
+
297
+
val is_root : t -> bool
298
+
(** [is_root p] is [true] iff [p] is a root directory, i.e. [p] has the
299
+
root directory separator and a single, empty, segment.
300
+
{{!ex_is_root}Examples}.
301
+
302
+
{b Warning.} By definition this is a syntactic test. For example it will
303
+
return [false] on ["/a/.."] or ["/.."]. {{!normalize}Normalizing}
304
+
the path before testing avoids this problem. *)
305
+
306
+
val is_current_dir : ?prefix:bool -> t -> bool
307
+
(** [is_current_dir p] is true iff [p] is the current relative directory,
308
+
i.e. either ["."] or ["./"]. If [prefix] is [true] (defaults to [false])
309
+
simply checks that [p] is {{!is_rel}relative} and its first segment
310
+
is ["."].
311
+
312
+
{b Warning.} By definition this is a syntactic test. For example it will
313
+
return [false] on ["./a/.."] or ["./."]. {{!normalize}Normalizing} the
314
+
path before testing avoids this problem. *)
315
+
316
+
val is_parent_dir : ?prefix:bool -> t -> bool
317
+
(** [is_parent_dir p] is [true] iff [p] is the relative parent directory,
318
+
i.e. either [".."] or ["../"]. If [prefix] is [true] (defaults to [false]),
319
+
simply checks that [p] is {{!is_rel}relative} and its first segment
320
+
is [".."].
321
+
322
+
{b Warning.} By definition this is a syntactic test. For example it will
323
+
return [false] on ["./a/../.."] or ["./.."]. {{!normalize}Normalizing} the
324
+
path before testing avoids this problem. *)
325
+
326
+
val is_dotfile : t -> bool
327
+
(** [is_dotfile p] is [true] iff [p]'s {{!basename}basename} is non
328
+
empty and starts with a ['.'].
329
+
330
+
{b Warning.} By definition this is a syntactic test. For example it will
331
+
return [false] on [".ssh/."]. {{!normalize}Normalizing} the
332
+
path before testing avoids this problem. *)
333
+
334
+
val equal : t -> t -> bool
335
+
(** [equal p p'] is [true] if [p] and [p'] have the same volume
336
+
are both relative or absolute and have the same segments.
337
+
338
+
{b Warning.} By definition this is a syntactic test. For example
339
+
[equal (v "./") (v "a/..")] is [false]. {{!normalize}Normalizing}
340
+
the paths before testing avoids this problem. *)
341
+
342
+
val compare : t -> t -> int
343
+
(** [compare p p'] is a total order on paths compatible with {!equal}. *)
344
+
345
+
(** {1:conversions Conversions and pretty printing} *)
346
+
347
+
val to_string : t -> string
348
+
(** [to_string p] is the path [p] as a string. The result can
349
+
be safely converted back with {!v}. *)
350
+
351
+
val of_string : string -> (t, [`Msg of string]) result
352
+
(** [of_string s] is the string [s] as a path. The following transformations
353
+
are performed on the string:
354
+
{ul
355
+
{- On Windows any ['/'] occurence is converted to ['\\'] before
356
+
any processing occurs.}
357
+
{- Non-initial empty segments are suppressed;
358
+
["a//b"] becomes ["a/b"], ["//a////b//"] becomes ["//a/b/"], etc.}
359
+
{- On Windows empty absolute UNC paths are completed to
360
+
their root. For example ["\\\\server\\share"] becomes
361
+
["\\\\server\\share\\"],
362
+
but incomplete UNC volumes like ["\\\\a"] return [Error].}}
363
+
364
+
[Error (`Msg (strf "%S: invalid path" s))] is returned if
365
+
{ul
366
+
{- [s] or the path following the {{!split_volume}volume} is empty ([""]),
367
+
except on Windows UNC paths, see above.}
368
+
{- [s] has null byte (['\x00']).}
369
+
{- On Windows, [s] is an invalid UNC path (e.g. ["\\\\"] or ["\\\\a"])}}
370
+
*)
371
+
372
+
val pp : Format.formatter -> t -> unit
373
+
(** [pp ppf p] prints path [p] on [ppf] using {!to_string}. *)
374
+
375
+
val dump : Format.formatter -> t -> unit
376
+
(** [dump ppf p] prints path [p] on [ppf] using {!String.dump}. *)
377
+
378
+
(** {1:file_exts File extensions}
379
+
380
+
The {e file extension} (resp. {e multiple file extension}) of a
381
+
path segment is the suffix that starts at the last (resp. first)
382
+
occurence of a ['.'] that is preceeded by at least one non ['.']
383
+
character. If there is no such occurence in the segment, the
384
+
extension is empty. With these definitions, ["."], [".."],
385
+
["..."] and dot files like [".ocamlinit"] or ["..ocamlinit"] have
386
+
no extension, but [".emacs.d"] and ["..emacs.d"] do have one.
387
+
388
+
{b Warning.} The following functions act on paths whose
389
+
{{!basename}basename} is non empty and do nothing otherwise.
390
+
{{!normalize}Normalizing} [p] before using the functions ensures
391
+
that the functions do nothing iff [p] cannot be named, see
392
+
{!basename}. *)
393
+
394
+
type ext = string
395
+
(** The type for file extensions. *)
396
+
397
+
val get_ext : ?multi:bool -> t -> ext
398
+
(** [get_ext p] is [p]'s {{!basename}basename} file extension or the
399
+
empty string if there is no extension. If [multi] is [true]
400
+
(defaults to [false]), returns the multiple file
401
+
extension. {{!ex_get_ext}Examples}. *)
402
+
403
+
val has_ext : ext -> t -> bool
404
+
(** [has_ext e p] is [true] iff [get_ext p = e || get_ext ~multi:true p = e].
405
+
If [e] doesn't start with a ['.'] one is prefixed before making
406
+
the test. {{!ex_has_ext}Examples}. *)
407
+
408
+
val mem_ext : ext list -> t -> bool
409
+
(** [mem_ext exts p] is
410
+
[List.mem (get_ext p) exts || List.mem (get_ext ~multi:true p) exts]. *)
411
+
412
+
val exists_ext : ?multi:bool -> t -> bool
413
+
(** [exists_ext ~multi p] is [true] iff [p]'s {{!basename}basename}
414
+
file extension is not empty. If [multi] is [true] (default to
415
+
[false]) returns [true] iff [p] has {e more than one} extension.
416
+
{{!ex_exists_ext}Examples}. *)
417
+
418
+
val add_ext : ext -> t -> t
419
+
(** [add_ext ext p] is [p] with the string [ext] concatenated to [p]'s
420
+
{{!basename}basename}, if non empty. If [ext] doesn't start with a ['.']
421
+
one is prefixed to it before concatenation except if [ext] is
422
+
[""]. {{!ex_add_ext}Examples}.
423
+
424
+
@raise Invalid_argument if {!is_seg}[ ext] is [false]. *)
425
+
426
+
val rem_ext : ?multi:bool -> t -> t
427
+
(** [rem_ext p] is [p] with the extension of [p]'s
428
+
{{!basename}basename} removed. If [multi] is [true] (default to
429
+
[false]), the multiple file extension is
430
+
removed. {{!ex_rem_ext}Examples}. *)
431
+
432
+
val set_ext : ?multi:bool -> ext -> t -> t
433
+
(** [set_ext ?multi ext p] is [add_ext ext (rem_ext ?multi p)]. *)
434
+
435
+
val split_ext : ?multi:bool -> t -> t * ext
436
+
(** [split_ext ?multi p] is [(rem_ext ?multi p, get_ext ?multi p)]. If this is
437
+
[(q, ext)] the following invariant holds:
438
+
{ul
439
+
{- [equal p (add_ext q ext)]}} *)
440
+
441
+
val ( + ) : t -> ext -> t
442
+
(** [p + ext] is [add_ext ext p]. Left associative. *)
443
+
444
+
val ( -+ ) : t -> ext -> t
445
+
(** [p -+ ext] is [set_ext ext p]. Left associative. *)
446
+
447
+
(** {1:sets_maps Path sets and maps} *)
448
+
449
+
type path = t
450
+
451
+
type set
452
+
(** The type for path sets. Membership is determined according to {!equal}. *)
453
+
454
+
(** Path sets. *)
455
+
module Set : sig
456
+
457
+
(** {1 Path sets} *)
458
+
459
+
include Set.S with type elt := path
460
+
and type t := set
461
+
462
+
type t = set
463
+
464
+
val min_elt : set -> path option
465
+
(** Exception safe {!Set.S.min_elt}. *)
466
+
467
+
val get_min_elt : set -> path
468
+
(** [get_min_let] is like {!min_elt} but @raise Invalid_argument
469
+
on the empty set. *)
470
+
471
+
val max_elt : set -> path option
472
+
(** Exception safe {!Set.S.max_elt}. *)
473
+
474
+
val get_max_elt : set -> path
475
+
(** [get_max_elt] is like {!max_elt} but @raise Invalid_argument
476
+
on the empty set. *)
477
+
478
+
val choose : set -> path option
479
+
(** Exception safe {!Set.S.choose}. *)
480
+
481
+
val get_any_elt : set -> path
482
+
(** [get_any_elt] is like {!choose} but @raise Invalid_argument on the
483
+
empty set. *)
484
+
485
+
val find : path -> set -> path option
486
+
(** Exception safe {!Set.S.find}. *)
487
+
488
+
val get : path -> set -> path
489
+
(** [get] is like {!Set.S.find} but @raise Invalid_argument if
490
+
[elt] is not in [s]. *)
491
+
492
+
val of_list : path list -> set
493
+
(** [of_list ps] is a set from the list [ps]. *)
494
+
495
+
val pp : ?sep:(Format.formatter -> unit -> unit) ->
496
+
(Format.formatter -> path -> unit) ->
497
+
Format.formatter -> set -> unit
498
+
(** [pp ~sep pp_elt ppf ps] formats the elements of [ps] on
499
+
[ppf]. Each element is formatted with [pp_elt] and elements are
500
+
separated by [~sep] (defaults to {!Format.pp_print_cut}). If the
501
+
set is empty leaves [ppf] untouched. *)
502
+
503
+
val dump : Format.formatter -> set -> unit
504
+
(** [dump ppf ps] prints an unspecified representation of [ps] on
505
+
[ppf]. *)
506
+
end
507
+
508
+
(** Path maps. *)
509
+
module Map : sig
510
+
511
+
(** {1 Path maps} *)
512
+
513
+
include Map.S with type key := t
514
+
515
+
val min_binding : 'a t -> (path * 'a) option
516
+
(** Exception safe {!Map.S.min_binding}. *)
517
+
518
+
val get_min_binding : 'a t -> (path * 'a)
519
+
(** [get_min_binding] is like {!min_binding} but @raise Invalid_argument
520
+
on the empty map. *)
521
+
522
+
val max_binding : 'a t -> (path * 'a) option
523
+
(** Exception safe {!Map.S.max_binding}. *)
524
+
525
+
val get_max_binding : 'a t -> string * 'a
526
+
(** [get_min_binding] is like {!max_binding} but @raise Invalid_argument
527
+
on the empty map. *)
528
+
529
+
val choose : 'a t -> (path * 'a) option
530
+
(** Exception safe {!Map.S.choose}. *)
531
+
532
+
val get_any_binding : 'a t -> (path * 'a)
533
+
(** [get_any_binding] is like {!choose} but @raise Invalid_argument
534
+
on the empty map. *)
535
+
536
+
val find : path -> 'a t -> 'a option
537
+
(** Exception safe {!Map.S.find}. *)
538
+
539
+
val get : path -> 'a t -> 'a
540
+
(** [get k m] is like {!Map.S.find} but raises [Invalid_argument] if
541
+
[k] is not bound in [m]. *)
542
+
543
+
val dom : 'a t -> set
544
+
(** [dom m] is the domain of [m]. *)
545
+
546
+
val of_list : (path * 'a) list -> 'a t
547
+
(** [of_list bs] is [List.fold_left (fun m (k, v) -> add k v m) empty
548
+
bs]. *)
549
+
550
+
val pp : ?sep:(Format.formatter -> unit -> unit) ->
551
+
(Format.formatter -> path * 'a -> unit) -> Format.formatter ->
552
+
'a t -> unit
553
+
(** [pp ~sep pp_binding ppf m] formats the bindings of [m] on
554
+
[ppf]. Each binding is formatted with [pp_binding] and
555
+
bindings are separated by [sep] (defaults to
556
+
{!Format.pp_print_cut}). If the map is empty leaves [ppf]
557
+
untouched. *)
558
+
559
+
val dump : (Format.formatter -> 'a -> unit) -> Format.formatter ->
560
+
'a t -> unit
561
+
(** [dump pp_v ppf m] prints an unspecified representation of [m] on
562
+
[ppf] using [pp_v] to print the map codomain elements. *)
563
+
end
564
+
565
+
type +'a map = 'a Map.t
566
+
(** The type for maps from paths to values of type ['a]. Paths are compared
567
+
with {!compare}. *)
568
+
569
+
(** {1:tips Tips}
570
+
571
+
{ul
572
+
{- The documentation sometimes talks about {e the last non-empty segment of
573
+
a path}. This usually means that we don't care whether the path
574
+
is a {{!is_file_path}file path} (e.g. ["a"]) or a
575
+
{{!is_dir_path}directory path} (e.g. ["a/"]).}
576
+
{- Windows accepts both ['\\'] and ['/'] as directory separator.
577
+
However [Fpath] on Windows converts ['/'] to ['\\'] on the
578
+
fly. Therefore you should either use ['/'] for defining
579
+
constant paths you inject with {!v} or better, construct them
580
+
directly with {!(/)}. {!to_string} then converts paths to strings
581
+
using the platform's specific directory separator {!dir_sep}.}
582
+
{- Avoid platform specific {{!split_volume}volumes} or hard-coding file
583
+
hierarchy conventions in your constants.}
584
+
{- Do not assume there is a single root path and that it is
585
+
["/"]. On Windows each {{!split_volume}volume} can have a root path.
586
+
Use {!is_root} on {{!normalize}normalized} paths to detect roots.}
587
+
{- Do not use {!to_string} to construct URIs, {!to_string} uses
588
+
{!dir_sep} to separate segments, on Windows this is ['\\'] which
589
+
is not what URIs expect. Access path segments directly
590
+
with {!segs}; note that you will need to percent encode these.}}
591
+
592
+
{1:ex Examples}
593
+
594
+
{2:ex_add_seg {!add_seg}}
595
+
{ul
596
+
{- [equal (add_seg (v "/a") "b") (v "/a/b")]}
597
+
{- [equal (add_seg (v "/a/") "b") (v "/a/b")]}
598
+
{- [equal (add_seg (v "/a/b") "") (v "/a/b/")]}
599
+
{- [equal (add_seg (v "/a/b/") "") (v "/a/b/")]}
600
+
{- [equal (add_seg (v "/") "") (v "/")]}
601
+
{- [equal (add_seg (v "/") "a") (v "/a")]}
602
+
{- [equal (add_seg (v ".") "") (v "./")]}
603
+
{- [equal (add_seg (v ".") "a") (v "./a")]}
604
+
{- [equal (add_seg (v "..") "") (v "../")]}
605
+
{- [equal (add_seg (v "..") "a") (v "../a")]}}
606
+
607
+
{2:ex_append {!append}}
608
+
{ul
609
+
{- [equal (append (v "/a/b/") (v "e/f")) (v "/a/b/e/f")]}
610
+
{- [equal (append (v "/a/b") (v "e/f")) (v "/a/b/e/f")]}
611
+
{- [equal (append (v "/a/b/") (v "/e/f")) (v "/e/f")]}
612
+
{- [equal (append (v "a/b/") (v "e/f")) (v "a/b/e/f")]}
613
+
{- [equal (append (v "a/b") (v "C:e")) (v "C:e")] (Windows)}}
614
+
615
+
{2:ex_segs {!segs}}
616
+
{ul
617
+
{- [segs (v "/a/b/") = [""; "a"; "b"; ""]]}
618
+
{- [segs (v "/a/b") = [""; "a"; "b"]]}
619
+
{- [segs (v "a/b/") = ["a"; "b"; ""]]}
620
+
{- [segs (v "a/b") = ["a"; "b"]]}
621
+
{- [segs (v "a") = ["a"]]}
622
+
{- [segs (v "/") = [""; ""]]}
623
+
{- [segs (v "\\\\.\\dev\\") = ["";""]] (Windows)}
624
+
{- [segs (v "\\\\server\\share\\a") = ["";"a"]] (Windows)}
625
+
{- [segs (v "C:a") = ["a"]] (Windows)}
626
+
{- [segs (v "C:\\a") = ["";"a"]] (Windows)}}
627
+
628
+
{2:ex_is_dir_path {!is_dir_path}}
629
+
{ul
630
+
{- [is_dir_path (v ".") = true]}
631
+
{- [is_dir_path (v "..") = true]}
632
+
{- [is_dir_path (v "../") = true]}
633
+
{- [is_dir_path (v "/") = true]}
634
+
{- [is_dir_path (v "/a/b/") = true]}
635
+
{- [is_dir_path (v "/a/b") = false]}
636
+
{- [is_dir_path (v "a/") = true]}
637
+
{- [is_dir_path (v "a") = false]}
638
+
{- [is_dir_path (v "a/.") = true]}
639
+
{- [is_dir_path (v "a/..") = true]}
640
+
{- [is_dir_path (v "a/..b") = false]}
641
+
{- [is_dir_path (v "C:\\") = true] (Windows)}
642
+
{- [is_dir_path (v "C:a") = false] (Windows)}}
643
+
644
+
{2:ex_is_file_path {!is_file_path}}
645
+
{ul
646
+
{- [is_file_path (v ".") = false]}
647
+
{- [is_file_path (v "..") = false]}
648
+
{- [is_file_path (v "../") = false]}
649
+
{- [is_file_path (v "/") = false]}
650
+
{- [is_file_path (v "/a/b/") = false]}
651
+
{- [is_file_path (v "/a/b") = true]}
652
+
{- [is_file_path (v "a/") = false]}
653
+
{- [is_file_path (v "a") = true]}
654
+
{- [is_file_path (v "a/.") = false]}
655
+
{- [is_file_path (v "a/..") = false]}
656
+
{- [is_file_path (v "a/..b") = true]}
657
+
{- [is_file_path (v "C:\\") = false] (Windows)}
658
+
{- [is_file_path (v "C:a") = true] (Windows)}}
659
+
660
+
{2:ex_to_dir_path {!to_dir_path}}
661
+
{ul
662
+
{- [equal (to_dir_path @@ v ".") (v "./")]}
663
+
{- [equal (to_dir_path @@ v "..") (v "../")]}
664
+
{- [equal (to_dir_path @@ v "../") (v "../")]}
665
+
{- [equal (to_dir_path @@ v "/") (v "/")]}
666
+
{- [equal (to_dir_path @@ v "/a/b/") (v "/a/b/")]}
667
+
{- [equal (to_dir_path @@ v "/a/b") (v "/a/b/")]}
668
+
{- [equal (to_dir_path @@ v "a/") (v "a/")]}
669
+
{- [equal (to_dir_path @@ v "a") (v "a/")]}
670
+
{- [equal (to_dir_path @@ v "a/.") (v "a/./")]}
671
+
{- [equal (to_dir_path @@ v "a/..") (v "a/../")]}
672
+
{- [equal (to_dir_path @@ v "a/..b") (v "a/..b/")]}
673
+
{- [equal (to_dir_path @@ v "\\\\server\\share\\")
674
+
(v "\\\\server\\share\\")]
675
+
(Windows)}
676
+
{- [equal (to_dir_path @@ v "C:a") (v "C:a\\")] (Windows)}
677
+
{- [equal (to_dir_path @@ v "C:\\") (v "C:\\")] (Windows)}}
678
+
679
+
{2:ex_filename {!filename}}
680
+
{ul
681
+
{- [filename (v ".") = ""]}
682
+
{- [filename (v "./") = ""]}
683
+
{- [filename (v "..") = ""]}
684
+
{- [filename (v "../") = ""]}
685
+
{- [filename (v "../..") = ""]}
686
+
{- [filename (v "/") = ""]}
687
+
{- [filename (v "/a/b/") = ""]}
688
+
{- [filename (v "/a/b") = "b"]}
689
+
{- [filename (v "a/") = ""]}
690
+
{- [filename (v "a") = "a"]}
691
+
{- [filename (v "a/.") = ""]}
692
+
{- [filename (v "a/..") = ""]}
693
+
{- [filename (v "a/..b") = "..b"]}
694
+
{- [filename (v "C:\\") = ""] (Windows)}
695
+
{- [filename (v "C:a") = "a"] (Windows)}}
696
+
697
+
{2:ex_split_base {!split_base}}
698
+
{ul
699
+
{- [(split_base @@ v ".") = (v "./"), (v ".")]}
700
+
{- [(split_base @@ v "./") = (v "./"), (v "./")]}
701
+
{- [(split_base @@ v "..") = (v "./"), (v "..")]}
702
+
{- [(split_base @@ v "../") = (v "./"), (v "../")]}
703
+
{- [(split_base @@ v "../../") = (v "../"), (v "../")]}
704
+
{- [(split_base @@ v ".././") = (v "../"), (v "./")]}
705
+
{- [(split_base @@ v "../../../") = (v "../../"), (v "../")]}
706
+
{- [(split_base @@ v "/") = (v "/"), (v "./")]}
707
+
{- [(split_base @@ v "/a/b/") = (v "/a/"), (v "b/")]}
708
+
{- [(split_base @@ v "/a/b") = (v "/a/"), (v "b")]}
709
+
{- [(split_base @@ v "a/") = (v "./"), (v "a/")]}
710
+
{- [(split_base @@ v "a") = (v "./"), (v "a")]}
711
+
{- [(split_base @@ v "a/b") = (v "a/"), (v "b")]}
712
+
{- [(split_base @@ v "a/b/") = (v "a/b/"), (v "b/")]}
713
+
{- [(split_base @@ v "a/.") = (v "a/"), (v ".")]}
714
+
{- [(split_base @@ v "a/..") = (v "a/"), (v "..")]}
715
+
{- [(split_base @@ v "a/../..") = (v "a/../"), (v "..")]}
716
+
{- [(split_base @@ v "a/..b") = (v "a/"), (v "..b")]}
717
+
{- [(split_base @@ v "./a") = (v "./"), (v "a")]}
718
+
{- [(split_base @@ v "./a/") = (v "./"), (v "a/")]}
719
+
{- [(split_base @@ v "../a") = (v "../"), (v "a")]}
720
+
{- [(split_base @@ v "../a/") = (v "../"), (v "a/")]}}
721
+
722
+
{2:ex_basename {!basename}}
723
+
{ul
724
+
{- [basename (v ".") = ""]}
725
+
{- [basename (v "..") = ""]}
726
+
{- [basename (v "../") = ""]}
727
+
{- [basename (v "../../") = ""]}
728
+
{- [basename (v "/") = ""]}
729
+
{- [basename (v "/a/b/") = "b"]}
730
+
{- [basename (v "/a/b") = "b"]}
731
+
{- [basename (v "a/") = "a"]}
732
+
{- [basename (v "a") = "a"]}
733
+
{- [basename (v "a/.") = ""]}
734
+
{- [basename (v "a/./") = ""]}
735
+
{- [basename (v "a/..") = ""]}
736
+
{- [basename (v "a/..b") = "..b"]}
737
+
{- [basename (v "./a") = "a"]}
738
+
{- [basename (v "../a") = "a"]}
739
+
{- [basename (v "C:\\") = ""] (Windows)}
740
+
{- [basename (v "C:a") = "a"] (Windows)}}
741
+
742
+
{2:ex_parent {!parent}}
743
+
{ul
744
+
{- [equal (parent @@ v ".") (v "./../")]}
745
+
{- [equal (parent @@ v "..") (v "../../")]}
746
+
{- [equal (parent @@ v "../") (v "../../")]}
747
+
{- [equal (parent @@ v "../../") (v "../../../")]}
748
+
{- [equal (parent @@ v "/") (v "/")]}
749
+
{- [equal (parent @@ v "/a/b/") (v "/a/")]}
750
+
{- [equal (parent @@ v "/a/b") (v "/a/")]}
751
+
{- [equal (parent @@ v "a/") (v "./")]}
752
+
{- [equal (parent @@ v "a") (v "./")]}
753
+
{- [equal (parent @@ v "a/.") (v "a/./../")]}
754
+
{- [equal (parent @@ v "a/./") (v "a/./../")]}
755
+
{- [equal (parent @@ v "a/..") (v "a/../../")]}
756
+
{- [equal (parent @@ v "a/../") (v "a/../../")]}
757
+
{- [equal (parent @@ v "a/..b") (v "a/")]}
758
+
{- [equal (parent @@ v "./a") (v "./")]}
759
+
{- [equal (parent @@ v "../a") (v "../")]}
760
+
{- [equal (parent @@ v "../../a") (v "../../")]}
761
+
{- [equal (parent @@ v "\\\\server\\share\\") (v "\\\\server\\share\\")]
762
+
(Windows)}
763
+
{- [equal (parent @@ v "C:\\") (v "C:\\")] (Windows)}
764
+
{- [equal (parent @@ v "C:a") (v "C:.\\")] (Windows)}}
765
+
766
+
{2:ex_rem_empty_seg {!rem_empty_seg}}
767
+
{ul
768
+
{- [equal (rem_empty_seg @@ v ".") (v ".")]}
769
+
{- [equal (rem_empty_seg @@ v "..") (v "..")]}
770
+
{- [equal (rem_empty_seg @@ v "../") (v "..")]}
771
+
{- [equal (rem_empty_seg @@ v "../../") (v "../..")]}
772
+
{- [equal (rem_empty_seg @@ v "/") (v "/")]}
773
+
{- [equal (rem_empty_seg @@ v "/a/b/") (v "/a/b")]}
774
+
{- [equal (rem_empty_seg @@ v "/a/b") (v "/a/b")]}
775
+
{- [equal (rem_empty_seg @@ v "a/") (v "a")]}
776
+
{- [equal (rem_empty_seg @@ v "a") (v "a")]}
777
+
{- [equal (rem_empty_seg @@ v "a/.") (v "a/.")]}
778
+
{- [equal (rem_empty_seg @@ v "a/./") (v "a/.")]}
779
+
{- [equal (rem_empty_seg @@ v "a/..") (v "a/..")]}
780
+
{- [equal (rem_empty_seg @@ v "a/../") (v "a/..")]}
781
+
{- [equal (rem_empty_seg @@ v "a/..b") (v "a/..b")]}
782
+
{- [equal (rem_empty_seg @@ v "./a") (v "./a")]}
783
+
{- [equal (rem_empty_seg @@ v "../a") (v "../a")]}
784
+
{- [equal (rem_empty_seg @@ v "../../a") (v "../../a")]}
785
+
{- [equal (rem_empty_seg @@ v "\\\\server\\share\\")
786
+
(v "\\\\server\\share\\")] (Windows)}
787
+
{- [equal (rem_empty_seg @@ v "C:\\") (v "C:\\")] (Windows)}
788
+
{- [equal (rem_empty_seg @@ v "C:a\\") (v "C:a")] (Windows)}}
789
+
790
+
{2:ex_normalize {!normalize}}
791
+
{ul
792
+
{- [equal (normalize @@ v ".") (v "./")]}
793
+
{- [equal (normalize @@ v "..") (v "../")]}
794
+
{- [equal (normalize @@ v "../") (v "../")]}
795
+
{- [equal (normalize @@ v "../../") (v "../../")]}
796
+
{- [equal (normalize @@ v "/") (v "/")]}
797
+
{- [equal (normalize @@ v "/a/b/") (v "/a/b/")]}
798
+
{- [equal (normalize @@ v "/a/b") (v "/a/b")]}
799
+
{- [equal (normalize @@ v "a/") (v "a/")]}
800
+
{- [equal (normalize @@ v "a") (v "a")]}
801
+
{- [equal (normalize @@ v "a/.") (v "a/")]}
802
+
{- [equal (normalize @@ v "a/./") (v "a/")]}
803
+
{- [equal (normalize @@ v "a/..") (v "./")]}
804
+
{- [equal (normalize @@ v "a/../") (v "./")]}
805
+
{- [equal (normalize @@ v "a/..b") (v "a/..b")]}
806
+
{- [equal (normalize @@ v "./a") (v "a")]}
807
+
{- [equal (normalize @@ v "../a") (v "../a")]}
808
+
{- [equal (normalize @@ v "../../a") (v "../../a")]}
809
+
{- [equal (normalize @@ v "./a/..") (v "./")]}
810
+
{- [equal (normalize @@ v "/a/b/./..") (v "/a/")]}
811
+
{- [equal (normalize @@ v "/../..") (v "/")]}
812
+
{- [equal (normalize @@ v "/a/../..") (v "/")]}
813
+
{- [equal (normalize @@ v "./../..") (v "../../")]}
814
+
{- [equal (normalize @@ v "../../a/") (v "../../a/")]}
815
+
{- [equal (normalize @@ v "/a/b/c/./../../g") (v "/a/g")]}
816
+
{- [equal (normalize @@ v "/a/b/c/./../../g/") (v "/a/g/")]}
817
+
{- [equal (normalize @@ v "\\\\?\\UNC\\server\\share\\..")
818
+
(v "\\\\?\\UNC\\server\\share\\")] (Windows)}
819
+
{- [equal (normalize @@ v "\\\\server\\share\\")
820
+
(v "\\\\server\\share\\")] (Windows)}
821
+
{- [equal (normalize @@ v "C:\\") (v "C:\\")] (Windows)}
822
+
{- [equal (normalize @@ v "C:a\\") (v "C:a\\")] (Windows)}}
823
+
824
+
{2:ex_is_prefix {!is_prefix}}
825
+
{ul
826
+
{- [is_prefix (v "/a/b") (v "/a/b") = true]}
827
+
{- [is_prefix (v "/a/b") (v "/a/bc") = false]}
828
+
{- [is_prefix (v "/a/b") (v "/a/b/") = true]}
829
+
{- [is_prefix (v "a/b/") (v "a/b") = false]}
830
+
{- [is_prefix (v "a/b/") (v "a/b/") = true]}
831
+
{- [is_prefix (v "a/b/") (v "a/b/c") = true]}
832
+
{- [is_prefix (v ".") (v "./") = true]}
833
+
{- [is_prefix (v "..") (v ".") = false]}
834
+
{- [is_prefix (v "C:a") (v "a") = false] (Windows)}}
835
+
836
+
{2:ex_find_prefix {!find_prefix}}
837
+
{ul
838
+
{- [find_prefix (v "a/b/c") (v "a/b/d")] is [Some (v "a/b/")]}
839
+
{- [find_prefix (v "a/b/c") (v "a/b/cd")] is [Some (v "a/b/")]}
840
+
{- [find_prefix (v "a/b") (v "a/b")] is [Some (v "a/b")]}
841
+
{- [find_prefix (v "a/b") (v "a/b/")] is [Some (v "a/b")]}
842
+
{- [find_prefix (v "a/b") (v "e/f")] is [None]}
843
+
{- [find_prefix (v "/a/b") (v "/e/f")] is [Some (v "/")]}
844
+
{- [find_prefix (v "/a/b") (v "e/f")] is [None]}
845
+
{- [find_prefix (v "C:\\a") (v "\\a")] is [None] (Windows)}}
846
+
847
+
{2:ex_rem_prefix {!rem_prefix}}
848
+
{ul
849
+
{- [rem_prefix (v "a/b/") (v "a/b")] is [None]}
850
+
{- [rem_prefix (v "a/b/") (v "a/b/")] is [None]}
851
+
{- [rem_prefix (v "a/b") (v "a/b")] is [None]}
852
+
{- [rem_prefix (v "a/b") (v "a/b/")] is [Some "./"]}
853
+
{- [rem_prefix (v "a/b") (v "a/b/c")] is [Some (v "c")]}
854
+
{- [rem_prefix (v "a/b/") (v "a/b/c")] is [Some (v "c")]}
855
+
{- [rem_prefix (v "a/b") (v "a/b/c/")] is [Some (v "c/")]}
856
+
{- [rem_prefix (v "a/b/") (v "a/b/c/")] is [Some (v "c/")]}
857
+
{- [rem_prefix (v "C:\\a") (v "C:\\a\\b")] is [Some (v "b")] (Windows)}}
858
+
859
+
{2:ex_relativize {!relativize}}
860
+
{ul
861
+
{- [relativize ~root:(v "/a/b") (v "/a/b")] is [Some (v ".")]}
862
+
{- [relativize ~root:(v "/a/b") (v "/a/b/")] is [Some (v "./")]}
863
+
{- [relativize ~root:(v "/a/b/") (v "/a/b/")] is [Some (v "./")]}
864
+
{- [relativize ~root:(v "/a/b/") (v "/a/b")] is [Some (v "../b")]}
865
+
{- [relativize ~root:(v "a/b") (v "a/b")] is [Some (v ".")]}
866
+
{- [relativize ~root:(v "a/b/") (v "a/b/")] is [Some (v "./")]}
867
+
{- [relativize ~root:(v "a/b") (v "a/b/")] is [Some (v "./")]}
868
+
{- [relativize ~root:(v "a/b/") (v "a/b")] is [Some (v "../b")]}
869
+
{- [relativize ~root:(v "/a/b") (v "c")] is [None]}
870
+
{- [relativize ~root:(v "/a/b") (v "/c")] is [Some (v "../../c")]}
871
+
{- [relativize ~root:(v "/a/b") (v "/c/")] is [Some (v "../../c/")]}
872
+
{- [relativize ~root:(v "/a/b") (v "/c")] is [Some (v "../../c")]}
873
+
{- [relativize ~root:(v "/a/b") (v "/c/")] is [Some (v "../../c/")]}
874
+
{- [relativize ~root:(v "/a/b") (v "/a/b/c")] is [Some (v "c")]}
875
+
{- [relativize ~root:(v "/a/b") (v "/a/b/c/")] is [Some (v "c/")]}
876
+
{- [relativize ~root:(v "a/b") (v "/c")] is [None].}
877
+
{- [relativize ~root:(v "a/b") (v "c")] is [Some (v "../../c")]}
878
+
{- [relativize ~root:(v "a/b") (v "c/")] is [Some (v "../../c/")]}
879
+
{- [relativize ~root:(v "a/b") (v "a/b/c")] is [Some (v "c")]}
880
+
{- [relativize ~root:(v "a/b") (v "a/b")] is [Some (v ".")]}
881
+
{- [relativize ~root:(v "a/b") (v "a/b/")] is [Some (v ".")]}
882
+
{- [relativize ~root:(v "../") (v "./")] is [None]}
883
+
{- [relativize ~root:(v "../a") (v "b")] is [None]}
884
+
{- [relativize ~root:(v "../a") (v "../b/c")] is [Some (v "../b/c")]}
885
+
{- [relativize ~root:(v "../../a") (v "../b")] is [None]}
886
+
{- [relativize ~root:(v "../a") (v "../../b")] is [(Some "../../b")]}}
887
+
888
+
{2:ex_is_rooted {!is_rooted}}
889
+
{ul
890
+
{- [is_rooted ~root:(v "a/b") (v "a/b") = false]}
891
+
{- [is_rooted ~root:(v "a/b") (v "a/b/") = true]}
892
+
{- [is_rooted ~root:(v "a/b/") (v "a/b") = false]}
893
+
{- [is_rooted ~root:(v "a/b/") (v "a/b/") = true]}
894
+
{- [is_rooted ~root:(v "./") (v "a") = true]}
895
+
{- [is_rooted ~root:(v "./") (v "a/") = true]}
896
+
{- [is_rooted ~root:(v "./") (v "a/../") = true]}
897
+
{- [is_rooted ~root:(v "./") (v "..") = false]}
898
+
{- [is_rooted ~root:(v "../") (v "./") = false]}
899
+
{- [is_rooted ~root:(v "../") (v "a") = false]}
900
+
{- [is_rooted ~root:(v "../") (v "../") = true]}
901
+
{- [is_rooted ~root:(v "../") (v "../a") = true]}
902
+
{- [is_rooted ~root:(v "../a") (v "./") = false]}
903
+
{- [is_rooted ~root:(v "/a") (v "/a/..") = true]}
904
+
{- [is_rooted ~root:(v "/a") (v "/a/../") = true]}
905
+
{- [is_rooted ~root:(v "/a") (v "/..") = true]}}
906
+
907
+
{2:ex_is_root {!is_root}}
908
+
{ul
909
+
{- [is_root (v "/") = true]}
910
+
{- [is_root (v "/a") = false]}
911
+
{- [is_root (v "/a/..") = false]}
912
+
{- [is_root (v "//") = true] (POSIX)}
913
+
{- [is_root (v "\\\\.\\dev\\") = true] (Windows)}
914
+
{- [is_root (v "\\\\.\\dev\\a") = false] (Windows)}
915
+
{- [is_root (v "\\\\server\\share\\") = true] (Windows)}
916
+
{- [is_root (v "\\\\server\\share\\a") = false] (Windows)}
917
+
{- [is_root (v "C:\\") = true] (Windows)}
918
+
{- [is_root (v "C:a") = false] (Windows)}
919
+
{- [is_root (v "C:\\a") = false] (Windows)}}
920
+
921
+
{2:ex_get_ext {!get_ext}}
922
+
{ul
923
+
{- [get_ext (v "/") = ""]}
924
+
{- [get_ext (v "a/b") = ""]}
925
+
{- [get_ext (v "a/b.mli/..") = ""]}
926
+
{- [get_ext (v "a/b.mli/...") = ""]}
927
+
{- [get_ext (v "a/b.") = "."]}
928
+
{- [get_ext (v "a/b.mli") = ".mli"]}
929
+
{- [get_ext ~multi:true (v "a/b.mli") = ".mli"]}
930
+
{- [get_ext (v "a/b.mli/") = ".mli"]}
931
+
{- [get_ext (v "a/.ocamlinit") = ""]}
932
+
{- [get_ext (v "a/.emacs.d") = ".d"]}
933
+
{- [get_ext (v "a/.emacs.d/") = ".d"]}
934
+
{- [get_ext ~multi:true (v "a/.emacs.d") = ".d"]}
935
+
{- [get_ext (v "a.tar.gz") = ".gz"]}
936
+
{- [get_ext ~multi:true (v "a.tar.gz") = ".tar.gz"]}}
937
+
938
+
{2:ex_has_ext {!has_ext}}
939
+
{ul
940
+
{- [has_ext "mli" (v "a/b.mli") = true]}
941
+
{- [has_ext ".mli" (v "a/b.mli") = true]}
942
+
{- [has_ext ".mli" (v "a/b.mli/") = true]}
943
+
{- [has_ext ".mli" (v "a/bmli") = false]}
944
+
{- [has_ext "mli" (v "a/bmli") = false]}
945
+
{- [has_ext ".tar.gz" (v "a/f.tar.gz") = true]}
946
+
{- [has_ext "tar.gz" (v "a/f.tar.gz") = true]}
947
+
{- [has_ext ".gz" (v "a/f.tar.gz") = true]}
948
+
{- [has_ext ".tar" (v "a/f.tar.gz") = false]}
949
+
{- [has_ext ".cache" (v "a/.cache") = false]}
950
+
{- [has_ext "" (v "a/b") = false]}
951
+
{- [has_ext "" (v "a/b.") = true]}
952
+
{- [has_ext "." (v "a/b.") = true]}}
953
+
954
+
{2:ex_exists_ext {!exists_ext}}
955
+
{ul
956
+
{- [exists_ext (v "a/f") = false]}
957
+
{- [exists_ext (v "a/f.") = true]}
958
+
{- [exists_ext (v "a/f.gz") = true]}
959
+
{- [exists_ext ~multi:true (v "a/f.gz") = false]}
960
+
{- [exists_ext (v "a/f.tar.gz") = true]}
961
+
{- [exists_ext ~multi:true (v "a/f.tar.gz") = true]}
962
+
{- [exists_ext (v "a/f.tar.gz/") = true]}
963
+
{- [exists_ext (v ".emacs.d") = true]}
964
+
{- [exists_ext (v ".emacs.d/") = true]}
965
+
{- [exists_ext (v ".ocamlinit") = false]}}
966
+
967
+
{2:ex_add_ext {!add_ext}}
968
+
{ul
969
+
{- [equal (add_ext "mli" (v "a/b")) (v "a/b.mli")]}
970
+
{- [equal (add_ext ".mli" (v "a/b")) (v "a/b.mli")]}
971
+
{- [equal (add_ext ".mli" (v "a/b/")) (v "a/b.mli/")]}
972
+
{- [equal (add_ext ".mli" (v "/")) (v "/")]}
973
+
{- [equal (add_ext ".mli" (v "a/b/..")) (v "a/b/..")]}
974
+
{- [equal (add_ext "." (v "a/b")) (v "a/b.")]}
975
+
{- [equal (add_ext "" (v "a/b")) (v "a/b")]}
976
+
{- [equal (add_ext "tar.gz" (v "a/f")) (v "a/f.tar.gz")]}
977
+
{- [equal (add_ext ".tar.gz" (v "a/f")) (v "a/f.tar.gz")]}
978
+
{- [equal (add_ext "gz" (v "a/f.tar") ) (v "a/f.tar.gz")]}
979
+
{- [equal (add_ext ".gz" (v "a/f.tar") ) (v "a/f.tar.gz")]}}
980
+
981
+
{2:ex_rem_ext {!rem_ext}}
982
+
{ul
983
+
{- [equal (rem_ext @@ v "/") (v "/")]}
984
+
{- [equal (rem_ext @@ v "/a/b") (v "/a/b")]}
985
+
{- [equal (rem_ext @@ v "/a/b.mli") (v "/a/b")]}
986
+
{- [equal (rem_ext @@ v "/a/b.mli/") (v "/a/b/")]}
987
+
{- [equal (rem_ext @@ v "/a/b.mli/..") (v "/a/b.mli/..")]}
988
+
{- [equal (rem_ext @@ v "/a/b.mli/.") (v "/a/b.mli/.")]}
989
+
{- [equal (rem_ext @@ v "a/.ocamlinit") (v "a/.ocamlinit")]}
990
+
{- [equal (rem_ext @@ v "a/.emacs.d") (v "a/.emacs")]}
991
+
{- [equal (rem_ext @@ v "a/.emacs.d/") (v "a/.emacs/")]}
992
+
{- [equal (rem_ext @@ v "f.tar.gz") (v "f.tar")]}
993
+
{- [equal (rem_ext ~multi:true @@ v "f.tar.gz") (v "f")]}
994
+
{- [equal (rem_ext ~multi:true @@ v "f.tar.gz/") (v "f/")]}} *)
+1
vendor/opam/fpath/src/fpath.mllib
+1
vendor/opam/fpath/src/fpath.mllib
···
1
+
Fpath
+6
vendor/opam/fpath/src/fpath_top_init.ml
+6
vendor/opam/fpath/src/fpath_top_init.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The fpath programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
#install_printer Fpath.pp;;
+5
vendor/opam/fpath/src/top/dune
+5
vendor/opam/fpath/src/top/dune
+6
vendor/opam/fpath/src/top/fpath_top.ml
+6
vendor/opam/fpath/src/top/fpath_top.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The fpath programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let () = ignore (Toploop.use_file Format.err_formatter "fpath_top_init.ml")
+1
vendor/opam/fpath/src/top/fpath_top.mllib
+1
vendor/opam/fpath/src/top/fpath_top.mllib
···
1
+
Fpath_top
+1188
vendor/opam/fpath/test/test_fpath.ml
+1188
vendor/opam/fpath/test/test_fpath.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The fpath programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_testing
7
+
8
+
let windows = Sys.os_type = "Win32"
9
+
10
+
let eq = Test.eq (module Fpath)
11
+
let v = Fpath.v
12
+
13
+
let of_string =
14
+
Test.test "Fpath.{v,of_string}" @@ fun () ->
15
+
let eq = Test.(eq (T.result' ~ok:(module Fpath) ~error:T.true')) in
16
+
let ok s = Ok (v s) in
17
+
let error = Error (`Msg "any") in
18
+
eq (Fpath.of_string "/\x00") error ~__POS__;
19
+
eq (Fpath.of_string "/") (ok "/") ~__POS__;
20
+
Test.bool (Fpath.equal (v "/") (v "/ ")) false ~__POS__;
21
+
eq (Fpath.of_string "//") (if windows then error else ok "//") ~__POS__;
22
+
eq (Fpath.of_string "/a/b/c") (ok "/a/b/c") ~__POS__;
23
+
Test.bool (Fpath.equal (v "/a/b/c/") (v "/a/b/c")) false ~__POS__;
24
+
eq (Fpath.of_string "") error ~__POS__; (* no empty path *)
25
+
eq (Fpath.of_string "a///b///////c///") (ok "a/b/c/") ~__POS__;
26
+
eq (Fpath.of_string "a///b///////c") (ok "a/b/c") ~__POS__; (* seg collapse *)
27
+
if windows then begin
28
+
eq (Fpath.of_string "C:\x00") error ~__POS__;
29
+
eq (Fpath.of_string "C:") error ~__POS__; (* no empty path *)
30
+
eq (Fpath.of_string "C:\\") (ok "C:\\") ~__POS__;
31
+
eq (Fpath.of_string "C:rel") (ok "C:rel") ~__POS__;
32
+
eq (Fpath.of_string "\\\\") error ~__POS__;
33
+
eq (Fpath.of_string "\\\\server") error ~__POS__;
34
+
eq (Fpath.of_string "\\\\server\\") error ~__POS__;
35
+
eq (Fpath.of_string "\\\\server\\share")
36
+
(ok "\\\\server\\share\\") (* root add *) ~__POS__;
37
+
eq (Fpath.of_string "\\\\?") error ~__POS__;
38
+
eq (Fpath.of_string "\\\\?\\") error ~__POS__;
39
+
eq (Fpath.of_string "\\\\?\\a") error ~__POS__;
40
+
eq (Fpath.of_string "\\\\?\\a:") (ok "\\\\?\\a:\\") ~__POS__; (* root add *)
41
+
eq (Fpath.of_string "\\\\?\\a:\\") (ok "\\\\?\\a:\\") ~__POS__;
42
+
eq (Fpath.of_string "\\\\?\\a:\\c") (ok "\\\\?\\a:\\c") ~__POS__;
43
+
eq (Fpath.of_string "\\\\?\\server\\") error ~__POS__;
44
+
eq (Fpath.of_string "\\\\?\\server\\\\") error ~__POS__;
45
+
eq (Fpath.of_string "\\\\?\\server\\share")
46
+
(ok "\\\\?\\server\\share\\") ~__POS__; (* root add *)
47
+
eq (Fpath.of_string "\\\\?\\server\\\\share")
48
+
(ok "\\\\?\\server\\share\\") ~__POS__; (* seg collapse and root add *)
49
+
eq (Fpath.of_string "\\\\?\\server\\share\\")
50
+
(ok "\\\\?\\server\\share\\") ~__POS__;
51
+
eq (Fpath.of_string "\\\\?\\server\\share\\a")
52
+
(ok "\\\\?\\server\\share\\a") ~__POS__;
53
+
eq (Fpath.of_string "\\\\?\\UNC") error ~__POS__;
54
+
eq (Fpath.of_string "\\\\?\\UNC\\") error ~__POS__;
55
+
eq (Fpath.of_string "\\\\?\\UNC\\server") error ~__POS__;
56
+
eq (Fpath.of_string "\\\\?\\UNC\\server\\") error ~__POS__;
57
+
eq (Fpath.of_string "\\\\?\\UNC\\server\\\\") error ~__POS__;
58
+
eq (Fpath.of_string "\\\\?\\UNC\\server\\share")
59
+
(ok "\\\\?\\UNC\\server\\share\\") ~__POS__; (* root add *)
60
+
eq (Fpath.of_string "\\\\?\\UNC\\server\\share\\")
61
+
(ok "\\\\?\\UNC\\server\\share\\") ~__POS__;
62
+
eq (Fpath.of_string "\\\\?\\UNC\\server\\share\\a")
63
+
(ok "\\\\?\\UNC\\server\\share\\a") ~__POS__;
64
+
eq (Fpath.of_string "\\\\.") error ~__POS__;
65
+
eq (Fpath.of_string "\\\\.\\") error ~__POS__;
66
+
eq (Fpath.of_string "\\\\.\\device")
67
+
(ok "\\\\.\\device\\")(* root add *) ~__POS__;
68
+
eq (Fpath.of_string "\\\\.\\device\\") (ok "\\\\.\\device\\") ~__POS__;
69
+
eq (Fpath.of_string "\\\\.\\device\\a") (ok "\\\\.\\device\\a") ~__POS__;
70
+
end;
71
+
()
72
+
73
+
let dir_sep =
74
+
Test.test "Fpath.dir_sep" @@ fun () ->
75
+
Test.string Fpath.dir_sep (if windows then "\\" else "/") ~__POS__;
76
+
()
77
+
78
+
let is_seg =
79
+
Test.test "Fpath.is_seg" @@ fun () ->
80
+
Test.bool (Fpath.is_seg "abc") true ~__POS__;
81
+
Test.bool (Fpath.is_seg "ab/c") false ~__POS__;
82
+
Test.bool (Fpath.is_seg "ab\x00c") false ~__POS__;
83
+
if windows then Test.bool (Fpath.is_seg "ab\\c") false ~__POS__;
84
+
()
85
+
86
+
let add_seg =
87
+
Test.test "Fpath.add_seg" @@ fun () ->
88
+
Test.invalid_arg ~__POS__ (fun () -> Fpath.add_seg (v "a/b/c") "a\x00o");
89
+
Test.invalid_arg ~__POS__ (fun () -> Fpath.add_seg (v "a/b/c") "a/o");
90
+
if windows then
91
+
Test.invalid_arg ~__POS__ (fun () -> Fpath.add_seg (v "a/b/c") "a\\o");
92
+
eq (Fpath.add_seg (v "/a") "b") (v "/a/b") ~__POS__;
93
+
eq (Fpath.add_seg (v "/a/") "b") (v "/a/b") ~__POS__;
94
+
eq (Fpath.add_seg (v "a/b") "") (v "a/b/") ~__POS__;
95
+
eq (Fpath.add_seg (v "a/b/") "") (v "a/b/") ~__POS__;
96
+
eq (Fpath.add_seg (v "/a/b") "") (v "/a/b/") ~__POS__;
97
+
eq (Fpath.add_seg (v "/a/b/") "") (v "/a/b/") ~__POS__;
98
+
eq (Fpath.add_seg (v "/a/b/") "e") (v "/a/b/e") ~__POS__;
99
+
eq (Fpath.add_seg (v "/a/b") "e") (v "/a/b/e") ~__POS__;
100
+
eq (Fpath.add_seg (v "/") "") (v "/") ~__POS__;
101
+
eq (Fpath.add_seg (v "/") "a") (v "/a") ~__POS__;
102
+
eq (Fpath.add_seg (v ".") "a") (v "./a") ~__POS__;
103
+
eq (Fpath.add_seg (v ".") "") (v "./") ~__POS__;
104
+
eq (Fpath.add_seg (v "..") "a") (v "../a") ~__POS__;
105
+
eq (Fpath.add_seg (v "..") "") (v "../") ~__POS__;
106
+
()
107
+
108
+
let append =
109
+
Test.test "Fpath.append" @@ fun () ->
110
+
eq (Fpath.append (v "/a/b/") (v "e/f")) (v "/a/b/e/f") ~__POS__;
111
+
eq (Fpath.append (v "/a/b") (v "e/f")) (v "/a/b/e/f") ~__POS__;
112
+
eq (Fpath.append (v "/a/b/") (v "/e/f")) (v "/e/f") ~__POS__;
113
+
eq (Fpath.append (v "a/b/") (v "e/f")) (v "a/b/e/f") ~__POS__;
114
+
eq (Fpath.append (v "bla") (v "/bli")) (v "/bli") ~__POS__;
115
+
if not windows
116
+
then eq (Fpath.append (v "bla") (v "//bli")) (v "//bli") ~__POS__;
117
+
if windows then begin
118
+
eq (Fpath.append (v "a/b") (v "C:e")) (v "C:e") ~__POS__;
119
+
eq (Fpath.append (v "C:bla") (v "blu")) (v "C:bla/blu") ~__POS__;
120
+
eq (Fpath.append (v "C:\\bla") (v "blu")) (v "C:\\bla\\blu") ~__POS__;
121
+
eq (Fpath.append (v "C:\\bla") (v "\\blu")) (v "\\blu") ~__POS__;
122
+
eq (Fpath.append (v "\\\\srv\\share\\a") (v "b"))
123
+
(v "\\\\srv\\share\\a\\b") ~__POS__;
124
+
eq (Fpath.append (v "\\\\srv\\share\\a\\") (v "b"))
125
+
(v "\\\\srv\\share\\a\\b") ~__POS__;
126
+
end;
127
+
()
128
+
129
+
let split_volume =
130
+
Test.test "Fpath.split_volume" @@ fun () ->
131
+
let eq_split ?__POS__:pos p vol q =
132
+
Test.block ?__POS__:pos @@ fun () ->
133
+
let p = v p in
134
+
let vol', q' = Fpath.split_volume p in
135
+
Test.string vol vol' ~__POS__;
136
+
eq (v q) q' ~__POS__;
137
+
eq (v (vol' ^ (Fpath.to_string q'))) p ~__POS__;
138
+
in
139
+
eq_split "/bla" "" "/bla" ~__POS__;
140
+
eq_split "bla" "" "bla" ~__POS__;
141
+
eq_split "bla/a" "" "bla/a" ~__POS__;
142
+
eq_split "bla/a/" "" "bla/a/" ~__POS__;
143
+
if not windows then begin
144
+
eq_split "//" "/" "/" ~__POS__;
145
+
eq_split "//a/b/c" "/" "/a/b/c" ~__POS__;
146
+
eq_split "//a/b/c/" "/" "/a/b/c/" ~__POS__;
147
+
end;
148
+
if windows then begin
149
+
eq_split "C:." "C:" "." ~__POS__;
150
+
eq_split "C:\\" "C:" "\\" ~__POS__;
151
+
eq_split "C:\\a" "C:" "\\a" ~__POS__;
152
+
eq_split "C:rel" "C:" "rel" ~__POS__;
153
+
eq_split "\\\\server\\share\\" "\\\\server\\share" "\\" ~__POS__;
154
+
eq_split "\\\\server\\share\\a" "\\\\server\\share" "\\a" ~__POS__;
155
+
eq_split "\\\\?\\a:\\" "\\\\?\\a:" "\\" ~__POS__;
156
+
eq_split "\\\\?\\a:\\c" "\\\\?\\a:" "\\c" ~__POS__;
157
+
eq_split "\\\\?\\server\\share\\" "\\\\?\\server\\share" "\\" ~__POS__;
158
+
eq_split "\\\\?\\server\\share\\a" "\\\\?\\server\\share" "\\a" ~__POS__;
159
+
eq_split "\\\\?\\UNC\\server\\share\\" "\\\\?\\UNC\\server\\share" "\\"
160
+
~__POS__;
161
+
eq_split "\\\\?\\UNC\\server\\share\\a" "\\\\?\\UNC\\server\\share" "\\a"
162
+
~__POS__;
163
+
eq_split "\\\\.\\device\\" "\\\\.\\device" "\\" ~__POS__;
164
+
eq_split "\\\\.\\device\\a" "\\\\.\\device" "\\a" ~__POS__;
165
+
end;
166
+
()
167
+
168
+
let segs =
169
+
Test.test "Fpath.segs" @@ fun () ->
170
+
let eq = Test.(eq T.(list string)) in
171
+
eq (Fpath.segs @@ v "/a/b/") [""; "a"; "b"; ""] ~__POS__;
172
+
eq (Fpath.segs @@ v "/a/b") [""; "a"; "b"] ~__POS__;
173
+
eq (Fpath.segs @@ v "a/b/") ["a"; "b"; ""] ~__POS__;
174
+
eq (Fpath.segs @@ v "a/b") ["a"; "b"] ~__POS__;
175
+
eq (Fpath.segs @@ v "a") ["a"] ~__POS__;
176
+
eq (Fpath.segs @@ v "/") [""; ""] ~__POS__;
177
+
eq (Fpath.segs @@ v "/a/b/c") [""; "a"; "b"; "c"] ~__POS__;
178
+
eq (Fpath.segs @@ v "/a/b/c/") [""; "a"; "b"; "c"; ""] ~__POS__;
179
+
eq (Fpath.segs @@ v "a/b/c") ["a"; "b"; "c";] ~__POS__;
180
+
eq (Fpath.segs @@ v "a/b/c/") ["a"; "b"; "c"; ""] ~__POS__;
181
+
if not windows then begin
182
+
eq (Fpath.segs @@ v "//") [""; ""] ~__POS__;
183
+
eq (Fpath.segs @@ v "//a/b") [""; "a"; "b"] ~__POS__;
184
+
end;
185
+
if windows then begin
186
+
eq (Fpath.segs @@ v "C:\\bla") [""; "bla"] ~__POS__;
187
+
eq (Fpath.segs @@ v "C:bla") ["bla"] ~__POS__;
188
+
eq (Fpath.segs @@ v "\\\\Server\\share\\bla") [""; "bla"] ~__POS__;
189
+
eq (Fpath.segs @@ v "\\\\?\\C:\\bla") ["";"bla"] ~__POS__;
190
+
eq (Fpath.segs @@ v "\\\\?\\Server\\share\\bla") [""; "bla"] ~__POS__;
191
+
eq (Fpath.segs @@ v "\\\\?\\UNC\\Server\\share\\bla") [""; "bla"] ~__POS__;
192
+
eq (Fpath.segs @@ v "\\\\.\\dev\\bla") [""; "bla"] ~__POS__;
193
+
eq (Fpath.segs @@ v "\\a") [""; "a"] ~__POS__;
194
+
eq (Fpath.segs @@ v "\\a\\b") [""; "a"; "b"] ~__POS__;
195
+
eq (Fpath.segs @@ v "\\a\\b\\") [""; "a"; "b"; ""] ~__POS__;
196
+
eq (Fpath.segs @@ v "C:.") ["."] ~__POS__;
197
+
eq (Fpath.segs @@ v "C:\\") ["";""] ~__POS__;
198
+
eq (Fpath.segs @@ v "C:\\a") ["";"a"] ~__POS__;
199
+
eq (Fpath.segs @@ v "C:rel") ["rel";] ~__POS__;
200
+
eq (Fpath.segs @@ v "\\\\server\\share\\") [""; ""] ~__POS__;
201
+
eq (Fpath.segs @@ v "\\\\server\\share\\a") [""; "a"] ~__POS__;
202
+
eq (Fpath.segs @@ v "\\\\?\\a:\\") [""; ""] ~__POS__;
203
+
eq (Fpath.segs @@ v "\\\\?\\a:\\c") [""; "c"] ~__POS__;
204
+
eq (Fpath.segs @@ v "\\\\?\\server\\share\\") [""; ""] ~__POS__;
205
+
eq (Fpath.segs @@ v "\\\\?\\server\\share\\a") [""; "a"] ~__POS__;
206
+
eq (Fpath.segs @@ v "\\\\?\\UNC\\server\\share\\") [""; ""] ~__POS__;
207
+
eq (Fpath.segs @@ v "\\\\?\\UNC\\server\\share\\a") [""; "a"] ~__POS__;
208
+
eq (Fpath.segs @@ v "\\\\.\\device\\") ["";""] ~__POS__;
209
+
eq (Fpath.segs @@ v "\\\\.\\device\\a") ["";"a"] ~__POS__;
210
+
eq (Fpath.segs @@ v "\\\\server\\share\\a") ["";"a"] ~__POS__;
211
+
eq (Fpath.segs @@ v "C:a") ["a"] ~__POS__;
212
+
eq (Fpath.segs @@ v "C:\\a") ["";"a"] ~__POS__;
213
+
end;
214
+
()
215
+
216
+
let is_dir_path =
217
+
Test.test "Fpath.is_dir_path" @@ fun () ->
218
+
Test.bool (Fpath.is_dir_path (v ".")) true ~__POS__;
219
+
Test.bool (Fpath.is_dir_path (v "..")) true ~__POS__;
220
+
Test.bool (Fpath.is_dir_path (v "../")) true ~__POS__;
221
+
Test.bool (Fpath.is_dir_path (v "/a/b/")) true ~__POS__;
222
+
Test.bool (Fpath.is_dir_path (v "/a/b")) false ~__POS__;
223
+
Test.bool (Fpath.is_dir_path (v "a/")) true ~__POS__;
224
+
Test.bool (Fpath.is_dir_path (v "a")) false ~__POS__;
225
+
Test.bool (Fpath.is_dir_path (v "a/.")) true ~__POS__;
226
+
Test.bool (Fpath.is_dir_path (v "a/..")) true ~__POS__;
227
+
Test.bool (Fpath.is_dir_path (v "a/..b")) false ~__POS__;
228
+
Test.bool (Fpath.is_dir_path (v "/")) true ~__POS__;
229
+
if windows then begin
230
+
Test.bool (Fpath.is_dir_path (v "C:\\")) true ~__POS__;
231
+
Test.bool (Fpath.is_dir_path (v "C:a")) false ~__POS__;
232
+
end;
233
+
()
234
+
235
+
let is_file_path =
236
+
Test.test "Fpath.is_file_path" @@ fun () ->
237
+
Test.bool (Fpath.is_file_path (v ".")) false ~__POS__;
238
+
Test.bool (Fpath.is_file_path (v "..")) false ~__POS__;
239
+
Test.bool (Fpath.is_file_path (v "../")) false ~__POS__;
240
+
Test.bool (Fpath.is_file_path (v "/a/b/")) false ~__POS__;
241
+
Test.bool (Fpath.is_file_path (v "/a/b")) true ~__POS__;
242
+
Test.bool (Fpath.is_file_path (v "a/")) false ~__POS__;
243
+
Test.bool (Fpath.is_file_path (v "a")) true ~__POS__;
244
+
Test.bool (Fpath.is_file_path (v "a/.")) false ~__POS__;
245
+
Test.bool (Fpath.is_file_path (v "a/..")) false ~__POS__;
246
+
Test.bool (Fpath.is_file_path (v "a/..b")) true ~__POS__;
247
+
Test.bool (Fpath.is_file_path (v "/")) false ~__POS__;
248
+
if windows then begin
249
+
Test.bool (Fpath.is_file_path (v "C:\\")) false ~__POS__;
250
+
Test.bool (Fpath.is_file_path (v "C:a")) true ~__POS__;
251
+
end;
252
+
()
253
+
254
+
let to_dir_path =
255
+
Test.test "Fpath.to_dir_path" @@ fun () ->
256
+
eq (Fpath.to_dir_path @@ v ".") (v "./") ~__POS__;
257
+
eq (Fpath.to_dir_path @@ v "..") (v "../") ~__POS__;
258
+
eq (Fpath.to_dir_path @@ v "../") (v "../") ~__POS__;
259
+
eq (Fpath.to_dir_path @@ v "/a/b/") (v "/a/b/") ~__POS__;
260
+
eq (Fpath.to_dir_path @@ v "/a/b") (v "/a/b/") ~__POS__;
261
+
eq (Fpath.to_dir_path @@ v "a/") (v "a/") ~__POS__;
262
+
eq (Fpath.to_dir_path @@ v "a") (v "a/") ~__POS__;
263
+
eq (Fpath.to_dir_path @@ v "a/.") (v "a/./") ~__POS__;
264
+
eq (Fpath.to_dir_path @@ v "a/..") (v "a/../") ~__POS__;
265
+
eq (Fpath.to_dir_path @@ v "a/..b") (v "a/..b/") ~__POS__;
266
+
eq (Fpath.to_dir_path @@ v "/") (v "/") ~__POS__;
267
+
if not windows then begin
268
+
eq (Fpath.to_dir_path @@ v "//") (v "//") ~__POS__;
269
+
eq (Fpath.to_dir_path @@ v "//a") (v "//a/") ~__POS__;
270
+
end;
271
+
if windows then begin
272
+
eq (Fpath.to_dir_path @@
273
+
v "\\\\server\\share\\") (v "\\\\server\\share\\") ~__POS__;
274
+
eq (Fpath.to_dir_path @@ v "C:a") (v "C:a/") ~__POS__;
275
+
eq (Fpath.to_dir_path @@ v "C:\\") (v "C:\\") ~__POS__;
276
+
end;
277
+
()
278
+
279
+
let filename =
280
+
Test.test "Fpath.filename" @@ fun () ->
281
+
Test.string (Fpath.filename @@ v ".") "" ~__POS__;
282
+
Test.string (Fpath.filename @@ v "./") "" ~__POS__;
283
+
Test.string (Fpath.filename @@ v "..") "" ~__POS__;
284
+
Test.string (Fpath.filename @@ v "../") "" ~__POS__;
285
+
Test.string (Fpath.filename @@ v "../..") "" ~__POS__;
286
+
Test.string (Fpath.filename @@ v "../../") "" ~__POS__;
287
+
Test.string (Fpath.filename @@ v "/a/b/") "" ~__POS__;
288
+
Test.string (Fpath.filename @@ v "/a/b") "b" ~__POS__;
289
+
Test.string (Fpath.filename @@ v "a/") "" ~__POS__;
290
+
Test.string (Fpath.filename @@ v "a") "a" ~__POS__;
291
+
Test.string (Fpath.filename @@ v "a/.") "" ~__POS__;
292
+
Test.string (Fpath.filename @@ v "a/..") "" ~__POS__;
293
+
Test.string (Fpath.filename @@ v "a/..b") "..b" ~__POS__;
294
+
Test.string (Fpath.filename @@ v "/") "" ~__POS__;
295
+
Test.string (Fpath.filename @@ v "/a/b/") "" ~__POS__;
296
+
Test.string (Fpath.filename @@ v "/a/b") "b" ~__POS__;
297
+
Test.string (Fpath.filename @@ v "a") "a" ~__POS__;
298
+
Test.string (Fpath.filename @@ v "a/") "" ~__POS__;
299
+
Test.string (Fpath.filename @@ v "/") "" ~__POS__;
300
+
if not windows then begin
301
+
Test.string (Fpath.filename @@ v "//") "" ~__POS__;
302
+
Test.string (Fpath.filename @@ v "//..") "" ~__POS__;
303
+
Test.string (Fpath.filename @@ v "//a/b") "b" ~__POS__;
304
+
Test.string (Fpath.filename @@ v "//a/b/") "" ~__POS__;
305
+
end;
306
+
if windows then begin
307
+
Test.string (Fpath.filename @@ v "\\\\server\\share\\a") "a" ~__POS__;
308
+
Test.string (Fpath.filename @@ v "\\\\.\\device\\") "" ~__POS__;
309
+
Test.string (Fpath.filename @@ v "\\\\.\\device\\a") "a" ~__POS__;
310
+
Test.string (Fpath.filename @@ v "C:\\") "" ~__POS__;
311
+
Test.string (Fpath.filename @@ v "C:a") "a" ~__POS__;
312
+
end;
313
+
()
314
+
315
+
let split_base =
316
+
Test.test "Fpath.split_base" @@ fun () ->
317
+
let eq_split ?__POS__:pos p (d, b) =
318
+
Test.block ?__POS__:pos @@ fun () ->
319
+
let d', b' = Fpath.split_base (v p) in
320
+
eq (v d) d' ~__POS__;
321
+
eq (v b) b' ~__POS__;
322
+
in
323
+
eq_split "." ("./", ".") ~__POS__;
324
+
eq_split "./" ("./", "./") ~__POS__;
325
+
eq_split ".." ("./", "..") ~__POS__;
326
+
eq_split "../" ("./", "../") ~__POS__;
327
+
eq_split "../../" ("../", "../") ~__POS__;
328
+
eq_split ".././" ("../", "./") ~__POS__;
329
+
eq_split "../../../" ("../../", "../") ~__POS__;
330
+
eq_split "/" ("/", "./") ~__POS__;
331
+
eq_split "/a/b/" ("/a/", "b/") ~__POS__;
332
+
eq_split "/a/b" ("/a/", "b") ~__POS__;
333
+
eq_split "a/" ("./", "a/") ~__POS__;
334
+
eq_split "a" ("./", "a") ~__POS__;
335
+
eq_split "a/b" ("a/", "b") ~__POS__;
336
+
eq_split "a/b/" ("a/", "b/") ~__POS__;
337
+
eq_split "a/." ("a/", ".") ~__POS__;
338
+
eq_split "a/.." ("a/", "..") ~__POS__;
339
+
eq_split "a/../.." ("a/../", "..") ~__POS__;
340
+
eq_split "a/..b" ("a/", "..b") ~__POS__;
341
+
eq_split "./a" ("./", "a") ~__POS__;
342
+
eq_split "./a/" ("./", "a/") ~__POS__;
343
+
eq_split "../a" ("../", "a") ~__POS__;
344
+
eq_split "../a/" ("../", "a/") ~__POS__;
345
+
if not windows then begin
346
+
eq_split "//" ("//", "./") ~__POS__;
347
+
eq_split "//a/b" ("//a/", "b") ~__POS__;
348
+
eq_split "//a/b/" ("//a/", "b/") ~__POS__;
349
+
eq_split "//a" ("//", "a") ~__POS__;
350
+
eq_split "//a/" ("//", "a/") ~__POS__;
351
+
eq_split "//a/." ("//a/", ".") ~__POS__;
352
+
eq_split "//a/./" ("//a/", "./") ~__POS__;
353
+
end;
354
+
if windows then begin
355
+
eq_split "\\\\server\\share\\a" ("\\\\server\\share\\", "a") ~__POS__;
356
+
eq_split "\\\\.\\device\\" ("\\\\.\\device\\", ".\\") ~__POS__;
357
+
eq_split "\\\\.\\device\\a" ("\\\\.\\device\\", "a") ~__POS__;
358
+
eq_split "\\\\.\\device\\a\\" ("\\\\.\\device\\", "a\\") ~__POS__;
359
+
eq_split "C:\\" ("C:\\", ".\\") ~__POS__;
360
+
eq_split "C:a" ("C:.\\", "a") ~__POS__;
361
+
end;
362
+
()
363
+
364
+
let base =
365
+
Test.test "Fpath.base" @@ fun () ->
366
+
eq (Fpath.base @@ v ".") (v ".") ~__POS__;
367
+
eq (Fpath.base @@ v "./") (v "./") ~__POS__;
368
+
eq (Fpath.base @@ v "..") (v "..") ~__POS__;
369
+
eq (Fpath.base @@ v "../") (v "../") ~__POS__;
370
+
eq (Fpath.base @@ v "../../") (v "../") ~__POS__;
371
+
eq (Fpath.base @@ v ".././") (v "./") ~__POS__;
372
+
eq (Fpath.base @@ v "../../../") (v "../") ~__POS__;
373
+
eq (Fpath.base @@ v "/") (v "./") ~__POS__;
374
+
eq (Fpath.base @@ v "/a/b/") (v "b/") ~__POS__;
375
+
eq (Fpath.base @@ v "/a/b") (v "b") ~__POS__;
376
+
eq (Fpath.base @@ v "a/") (v "a/") ~__POS__;
377
+
eq (Fpath.base @@ v "a") (v "a") ~__POS__;
378
+
eq (Fpath.base @@ v "a/b") (v "b") ~__POS__;
379
+
eq (Fpath.base @@ v "a/b/") (v "b/") ~__POS__;
380
+
eq (Fpath.base @@ v "a/.") (v ".") ~__POS__;
381
+
eq (Fpath.base @@ v "a/..") (v "..") ~__POS__;
382
+
eq (Fpath.base @@ v "a/../..") (v "..") ~__POS__;
383
+
eq (Fpath.base @@ v "a/..b") (v "..b") ~__POS__;
384
+
eq (Fpath.base @@ v "./a") (v "a") ~__POS__;
385
+
eq (Fpath.base @@ v "./a/") (v "a/") ~__POS__;
386
+
eq (Fpath.base @@ v "../a") (v "a") ~__POS__;
387
+
eq (Fpath.base @@ v "../a/") (v "a/") ~__POS__;
388
+
if not windows then begin
389
+
eq (Fpath.base @@ v "//") (v "./") ~__POS__;
390
+
eq (Fpath.base @@ v "//a/b") (v "b") ~__POS__;
391
+
eq (Fpath.base @@ v "//a/b/") (v "b/") ~__POS__;
392
+
eq (Fpath.base @@ v "//a") (v "a") ~__POS__;
393
+
eq (Fpath.base @@ v "//a/") (v "a/") ~__POS__;
394
+
eq (Fpath.base @@ v "//a/.") (v ".") ~__POS__;
395
+
eq (Fpath.base @@ v "//a/./") (v "./") ~__POS__;
396
+
end;
397
+
if windows then begin
398
+
eq (Fpath.base @@ v "\\\\server\\share\\a") (v "a") ~__POS__;
399
+
eq (Fpath.base @@ v "\\\\.\\device\\") (v ".\\") ~__POS__;
400
+
eq (Fpath.base @@ v "\\\\.\\device\\a") (v "a") ~__POS__;
401
+
eq (Fpath.base @@ v "\\\\.\\device\\a\\") (v "a\\") ~__POS__;
402
+
eq (Fpath.base @@ v "C:\\") (v ".\\") ~__POS__;
403
+
eq (Fpath.base @@ v "C:a") (v "a") ~__POS__;
404
+
end;
405
+
()
406
+
407
+
let basename =
408
+
Test.test "Fpath.basename" @@ fun () ->
409
+
Test.string (Fpath.basename @@ v ".") "" ~__POS__;
410
+
Test.string (Fpath.basename @@ v "..") "" ~__POS__;
411
+
Test.string (Fpath.basename @@ v "../") "" ~__POS__;
412
+
Test.string (Fpath.basename @@ v "../../") "" ~__POS__;
413
+
Test.string (Fpath.basename @@ v "/") "" ~__POS__;
414
+
Test.string (Fpath.basename @@ v "/a/b/") "b" ~__POS__;
415
+
Test.string (Fpath.basename @@ v "/a/b") "b" ~__POS__;
416
+
Test.string (Fpath.basename @@ v "a/") "a" ~__POS__;
417
+
Test.string (Fpath.basename @@ v "a") "a" ~__POS__;
418
+
Test.string (Fpath.basename @@ v "a/.") "" ~__POS__;
419
+
Test.string (Fpath.basename @@ v "a/./") "" ~__POS__;
420
+
Test.string (Fpath.basename @@ v "a/..") "" ~__POS__;
421
+
Test.string (Fpath.basename @@ v "a/..b") "..b" ~__POS__;
422
+
Test.string (Fpath.basename @@ v "./a") "a" ~__POS__;
423
+
Test.string (Fpath.basename @@ v "../a") "a" ~__POS__;
424
+
if not windows then begin
425
+
Test.string (Fpath.basename @@ v "//") "" ~__POS__;
426
+
Test.string (Fpath.basename @@ v "//a/b") "b" ~__POS__;
427
+
Test.string (Fpath.basename @@ v "//a/b/") "b" ~__POS__;
428
+
end;
429
+
if windows then begin
430
+
Test.string (Fpath.basename @@ v "\\\\server\\share\\a") "a" ~__POS__;
431
+
Test.string (Fpath.basename @@ v "\\\\server\\share\\a\\") "a" ~__POS__;
432
+
Test.string (Fpath.basename @@ v "\\\\.\\device\\") "" ~__POS__;
433
+
Test.string (Fpath.basename @@ v "\\\\.\\device\\a") "a" ~__POS__;
434
+
Test.string (Fpath.basename @@ v "C:\\") "" ~__POS__;
435
+
Test.string (Fpath.basename @@ v "C:a") "a" ~__POS__;
436
+
end;
437
+
()
438
+
439
+
let parent =
440
+
Test.test "Fpath.parent" @@ fun () ->
441
+
eq (Fpath.parent @@ v ".") (v "./../") ~__POS__;
442
+
eq (Fpath.parent @@ v "..") (v "../../") ~__POS__;
443
+
eq (Fpath.parent @@ v "../") (v "../../") ~__POS__;
444
+
eq (Fpath.parent @@ v "../../") (v "../../../") ~__POS__;
445
+
eq (Fpath.parent @@ v "/") (v "/") ~__POS__;
446
+
eq (Fpath.parent @@ v "/a/b/") (v "/a/") ~__POS__;
447
+
eq (Fpath.parent @@ v "/a/b") (v "/a/") ~__POS__;
448
+
eq (Fpath.parent @@ v "a/") (v "./") ~__POS__;
449
+
eq (Fpath.parent @@ v "a") (v "./") ~__POS__;
450
+
eq (Fpath.parent @@ v "a/.") (v "a/./../") ~__POS__;
451
+
eq (Fpath.parent @@ v "a/./") (v "a/./../") ~__POS__;
452
+
eq (Fpath.parent @@ v "a/..") (v "a/../../") ~__POS__;
453
+
eq (Fpath.parent @@ v "a/../") (v "a/../../") ~__POS__;
454
+
eq (Fpath.parent @@ v "a/..b") (v "a/") ~__POS__;
455
+
eq (Fpath.parent @@ v "./a") (v "./") ~__POS__;
456
+
eq (Fpath.parent @@ v "../a") (v "../") ~__POS__;
457
+
eq (Fpath.parent @@ v "../../a") (v "../../") ~__POS__;
458
+
if not windows then begin
459
+
eq (Fpath.parent @@ v "//") (v "//") ~__POS__;
460
+
eq (Fpath.parent @@ v "//.") (v "//./../") ~__POS__;
461
+
eq (Fpath.parent @@ v "//a/b") (v "//a/") ~__POS__;
462
+
eq (Fpath.parent @@ v "//a/b/") (v "//a/") ~__POS__;
463
+
eq (Fpath.parent @@ v "//a/b/..") (v "//a/b/../../") ~__POS__;
464
+
eq (Fpath.parent @@ v "//a/b/../") (v "//a/b/../../") ~__POS__;
465
+
eq (Fpath.parent @@ v "//a") (v "//") ~__POS__;
466
+
eq (Fpath.parent @@ v "//abcd") (v "//") ~__POS__;
467
+
end;
468
+
if windows then begin
469
+
eq (Fpath.parent @@ v "\\\\server\\share\\") (v "\\\\server\\share\\")
470
+
~__POS__;
471
+
eq (Fpath.parent @@ v "C:a") (v "C:.\\") ~__POS__;
472
+
eq (Fpath.parent @@ v "C:\\") (v "C:\\") ~__POS__;
473
+
eq (Fpath.parent @@ v "C:\\a\\b\\") (v "C:\\a\\") ~__POS__;
474
+
eq (Fpath.parent @@ v "C:\\a\\b") (v "C:\\a\\") ~__POS__;
475
+
eq (Fpath.parent @@ v "C:a\\b\\") (v "C:a\\") ~__POS__;
476
+
eq (Fpath.parent @@ v "C:a\\b") (v "C:a\\") ~__POS__;
477
+
eq (Fpath.parent @@ v "C:a\\..") (v "C:a\\..\\..\\") ~__POS__;
478
+
end;
479
+
()
480
+
481
+
let rem_empty_seg =
482
+
Test.test "Fpath.rem_empty_seg" @@ fun () ->
483
+
eq (Fpath.rem_empty_seg @@ v ".") (v ".") ~__POS__;
484
+
eq (Fpath.rem_empty_seg @@ v "..") (v "..") ~__POS__;
485
+
eq (Fpath.rem_empty_seg @@ v "../") (v "..") ~__POS__;
486
+
eq (Fpath.rem_empty_seg @@ v "../../") (v "../..") ~__POS__;
487
+
eq (Fpath.rem_empty_seg @@ v "/") (v "/") ~__POS__;
488
+
eq (Fpath.rem_empty_seg @@ v "/a/b/") (v "/a/b") ~__POS__;
489
+
eq (Fpath.rem_empty_seg @@ v "/a/b") (v "/a/b") ~__POS__;
490
+
eq (Fpath.rem_empty_seg @@ v "a/") (v "a") ~__POS__;
491
+
eq (Fpath.rem_empty_seg @@ v "a") (v "a") ~__POS__;
492
+
eq (Fpath.rem_empty_seg @@ v "a/.") (v "a/.") ~__POS__;
493
+
eq (Fpath.rem_empty_seg @@ v "a/./") (v "a/.") ~__POS__;
494
+
eq (Fpath.rem_empty_seg @@ v "a/..") (v "a/..") ~__POS__;
495
+
eq (Fpath.rem_empty_seg @@ v "a/../") (v "a/..") ~__POS__;
496
+
eq (Fpath.rem_empty_seg @@ v "a/..b") (v "a/..b") ~__POS__;
497
+
eq (Fpath.rem_empty_seg @@ v "./a") (v "./a") ~__POS__;
498
+
eq (Fpath.rem_empty_seg @@ v "../a") (v "../a") ~__POS__;
499
+
eq (Fpath.rem_empty_seg @@ v "../../a") (v "../../a") ~__POS__;
500
+
if not windows then begin
501
+
eq (Fpath.rem_empty_seg @@ v "//") (v "//") ~__POS__;
502
+
eq (Fpath.rem_empty_seg @@ v "//a") (v "//a") ~__POS__;
503
+
eq (Fpath.rem_empty_seg @@ v "//a/") (v "//a") ~__POS__;
504
+
end;
505
+
if windows then begin
506
+
eq (Fpath.rem_empty_seg @@ v "\\\\server\\share\\")
507
+
(v "\\\\server\\share\\") ~__POS__;
508
+
eq (Fpath.rem_empty_seg @@ v "\\\\server\\share\\a\\")
509
+
(v "\\\\server\\share\\a") ~__POS__;
510
+
eq (Fpath.rem_empty_seg @@ v "C:a") (v "C:a") ~__POS__;
511
+
eq (Fpath.rem_empty_seg @@ v "C:a\\") (v "C:a") ~__POS__;
512
+
eq (Fpath.rem_empty_seg @@ v "C:\\") (v "C:\\") ~__POS__;
513
+
end;
514
+
()
515
+
516
+
let normalize =
517
+
Test.test "Fpath.normalize" @@ fun () ->
518
+
eq (Fpath.normalize @@ v ".") (v "./") ~__POS__;
519
+
eq (Fpath.normalize @@ v "..") (v "../") ~__POS__;
520
+
eq (Fpath.normalize @@ v "../") (v "../") ~__POS__;
521
+
eq (Fpath.normalize @@ v "../..") (v "../../") ~__POS__;
522
+
eq (Fpath.normalize @@ v "../../") (v "../../") ~__POS__;
523
+
eq (Fpath.normalize @@ v "/") (v "/") ~__POS__;
524
+
eq (Fpath.normalize @@ v "/a/b/") (v "/a/b/") ~__POS__;
525
+
eq (Fpath.normalize @@ v "/a/b") (v "/a/b") ~__POS__;
526
+
eq (Fpath.normalize @@ v "a/") (v "a/") ~__POS__;
527
+
eq (Fpath.normalize @@ v "a") (v "a") ~__POS__;
528
+
eq (Fpath.normalize @@ v "a/.") (v "a/") ~__POS__;
529
+
eq (Fpath.normalize @@ v "a/./") (v "a/") ~__POS__;
530
+
eq (Fpath.normalize @@ v "a/..") (v "./") ~__POS__;
531
+
eq (Fpath.normalize @@ v "a/../") (v "./") ~__POS__;
532
+
eq (Fpath.normalize @@ v "a/..b") (v "a/..b") ~__POS__;
533
+
eq (Fpath.normalize @@ v "./a") (v "a") ~__POS__;
534
+
eq (Fpath.normalize @@ v "../a") (v "../a") ~__POS__;
535
+
eq (Fpath.normalize @@ v "a/..") (v "./") ~__POS__;
536
+
eq (Fpath.normalize @@ v "../../a") (v "../../a") ~__POS__;
537
+
eq (Fpath.normalize @@ v "./a/..") (v "./") ~__POS__;
538
+
eq (Fpath.normalize @@ v "/a/b/./..") (v "/a/") ~__POS__;
539
+
eq (Fpath.normalize @@ v "/../..") (v "/") ~__POS__;
540
+
eq (Fpath.normalize @@ v "/a/../..") (v "/") ~__POS__;
541
+
eq (Fpath.normalize @@ v "./../..") (v "../../") ~__POS__;
542
+
eq (Fpath.normalize @@ v "../../a/") (v "../../a/") ~__POS__;
543
+
eq (Fpath.normalize @@ v "a/../a/") (v "a/") ~__POS__;
544
+
eq (Fpath.normalize @@ v "a/../a/../..") (v "../") ~__POS__;
545
+
eq (Fpath.normalize @@ v "/a/../a/../..") (v "/") ~__POS__;
546
+
eq (Fpath.normalize @@ v "/a/b/c/./../../g") (v "/a/g") ~__POS__;
547
+
eq (Fpath.normalize @@ v "/a/b/c/./../../g/") (v "/a/g/") ~__POS__;
548
+
eq (Fpath.normalize @@ v "a/b/c/./../../g") (v "a/g") ~__POS__;
549
+
eq (Fpath.normalize @@ v "a/b/c/./../../g/") (v "a/g/") ~__POS__;
550
+
eq (Fpath.normalize @@ v "././.") (v "./") ~__POS__;
551
+
eq (Fpath.normalize @@ v "./././") (v "./") ~__POS__;
552
+
eq (Fpath.normalize @@ v "./a/..") (v "./") ~__POS__;
553
+
eq (Fpath.normalize @@ v "./a/../") (v "./") ~__POS__;
554
+
eq (Fpath.normalize @@ v "..") (v "../") ~__POS__;
555
+
eq (Fpath.normalize @@ v "../../../a") (v "../../../a") ~__POS__;
556
+
eq (Fpath.normalize @@ v "../../../a/") (v "../../../a/") ~__POS__;
557
+
eq (Fpath.normalize @@ v "/") (v "/") ~__POS__;
558
+
eq (Fpath.normalize @@ v "/.") (v "/") ~__POS__;
559
+
eq (Fpath.normalize @@ v "/..") (v "/") ~__POS__;
560
+
eq (Fpath.normalize @@ v "/./../../.") (v "/") ~__POS__;
561
+
eq (Fpath.normalize @@ v "/./../../.") (v "/") ~__POS__;
562
+
eq (Fpath.normalize @@ v "../../a/..") (v "../../") ~__POS__;
563
+
eq (Fpath.normalize @@ v "../../a/../.") (v "../../") ~__POS__;
564
+
eq (Fpath.normalize @@ v "../../a/.././..") (v "../../../") ~__POS__;
565
+
eq (Fpath.normalize @@ v "../../a/../..") (v "../../../") ~__POS__;
566
+
eq (Fpath.normalize @@ v "/a/b/c/./../../g") (v "/a/g") ~__POS__;
567
+
eq (Fpath.normalize @@ v "./a/b/c/./../../g") (v "a/g") ~__POS__;
568
+
eq (Fpath.normalize @@ v "./a/b/c/./../../g/") (v "a/g/") ~__POS__;
569
+
if not windows then begin
570
+
eq (Fpath.normalize @@ v "//a/b/c/./../../g") (v "//a/g") ~__POS__;
571
+
eq (Fpath.normalize @@ v "//a/b/c/./../../g/") (v "//a/g/") ~__POS__;
572
+
end;
573
+
if windows then begin
574
+
eq (Fpath.normalize @@ v "C:/a/b/c/./../../g") (v "C:/a/g") ~__POS__;
575
+
eq (Fpath.normalize @@ v "C:/a/b/c/./../../g/") (v "C:/a/g/") ~__POS__;
576
+
eq (Fpath.normalize @@ v "\\\\?\\UNC\\server\\share\\..")
577
+
(v "\\\\?\\UNC\\server\\share\\") ~__POS__;
578
+
end;
579
+
()
580
+
581
+
let is_prefix =
582
+
Test.test "Fpath.is_prefix" @@ fun () ->
583
+
Test.bool (Fpath.is_prefix (v "/a/b") (v "/a/b")) true ~__POS__;
584
+
Test.bool (Fpath.is_prefix (v "/a/b") (v "/a/bc")) false ~__POS__;
585
+
Test.bool (Fpath.is_prefix (v "/a/b") (v "/a/b/")) true ~__POS__;
586
+
Test.bool (Fpath.is_prefix (v "a/b/") (v "a/b")) false ~__POS__;
587
+
Test.bool (Fpath.is_prefix (v "a/b/") (v "a/b/")) true ~__POS__;
588
+
Test.bool (Fpath.is_prefix (v "a/b/") (v "a/b/c")) true ~__POS__;
589
+
Test.bool (Fpath.is_prefix (v ".") (v "./")) true ~__POS__;
590
+
Test.bool (Fpath.is_prefix (v "..") (v ".")) false ~__POS__;
591
+
Test.bool (Fpath.is_prefix (v ".") (v "..")) false ~__POS__;
592
+
Test.bool (Fpath.is_prefix (v "/a/b") (v "/a/b/c")) true ~__POS__;
593
+
Test.bool (Fpath.is_prefix (v "/a/b/") (v "/a/b/c")) true ~__POS__;
594
+
Test.bool (Fpath.is_prefix (v "/a/b/") (v "/a/b")) false ~__POS__;
595
+
Test.bool (Fpath.is_prefix (v "/a/b/") (v "/a/b")) false ~__POS__;
596
+
Test.bool (Fpath.is_prefix (v "a/b") (v "/a/b")) false ~__POS__;
597
+
Test.bool (Fpath.is_prefix (v "abcd/") (v "abcd")) false ~__POS__;
598
+
Test.bool (Fpath.is_prefix (v "abcd") (v "abcd/bla")) true ~__POS__;
599
+
if not windows then begin
600
+
Test.bool (Fpath.is_prefix (v "//a/b") (v "/a/b")) false ~__POS__;
601
+
end;
602
+
if windows then begin
603
+
Test.bool (Fpath.is_prefix (v "C:a") (v "a")) false ~__POS__;
604
+
end;
605
+
()
606
+
607
+
let find_prefix =
608
+
Test.test "Fpath.find_prefix" @@ fun () ->
609
+
let eq = Test.(eq T.(option (module Fpath))) in
610
+
let find_prefix ?__POS__:pos p0 p1 r =
611
+
Test.block ?__POS__:pos @@ fun () ->
612
+
eq (Fpath.find_prefix p0 p1) r ~__POS__;
613
+
eq (Fpath.find_prefix p1 p0) r ~__POS__;
614
+
in
615
+
find_prefix (v "a/b/c") (v "a/b/d") (Some (v "a/b/")) ~__POS__;
616
+
find_prefix (v "a/b/c") (v "a/b/cd") (Some (v "a/b/")) ~__POS__;
617
+
find_prefix (v "a/b") (v "a/b") (Some (v "a/b")) ~__POS__;
618
+
find_prefix (v "a/b") (v "a/b/") (Some (v "a/b")) ~__POS__;
619
+
find_prefix (v "a/b") (v "e/f") None ~__POS__;
620
+
find_prefix (v "/a/b") (v "/e/f") (Some (v "/")) ~__POS__;
621
+
find_prefix (v "/a/b") (v "e/f") None ~__POS__;
622
+
find_prefix (v "/a/b/c") (v "/a/b/d") (Some (v "/a/b/")) ~__POS__;
623
+
find_prefix (v "ab") (v "abc") None ~__POS__;
624
+
find_prefix (v "ab") (v "ab") (Some (v "ab")) ~__POS__;
625
+
find_prefix (v "/") (v "/") (Some (v "/")) ~__POS__;
626
+
find_prefix (v "a/") (v "a") (Some (v "a")) ~__POS__;
627
+
find_prefix (v "abc/") (v "abc") (Some (v "abc")) ~__POS__;
628
+
find_prefix (v "abcd/") (v "abc") None ~__POS__;
629
+
find_prefix (v "a/") (v "a/a") (Some (v "a/")) ~__POS__;
630
+
if not windows then begin
631
+
find_prefix (v "//") (v "/") None ~__POS__;
632
+
find_prefix (v "/") (v "//") None ~__POS__;
633
+
find_prefix (v "//") (v "/a/b") None ~__POS__;
634
+
find_prefix (v "//a/b/c") (v "/") None ~__POS__;
635
+
find_prefix (v "//a/b/c") (v "//") (Some (v "//")) ~__POS__;
636
+
find_prefix (v "//a/b") (v "/a/b") None ~__POS__;
637
+
find_prefix (v "//a/c") (v "/a/b") None ~__POS__;
638
+
find_prefix (v "//a/c") (v "a/b") None ~__POS__;
639
+
end;
640
+
if windows then begin
641
+
find_prefix (v "C:\\a") (v "\\a") None ~__POS__;
642
+
find_prefix (v "C:\\a") (v "C:\\a") (Some (v "C:\\a")) ~__POS__;
643
+
find_prefix (v "C:a") (v "C:a") (Some (v "C:a")) ~__POS__;
644
+
find_prefix (v "C:a") (v "C:b") None ~__POS__;
645
+
find_prefix (v "C:a") (v "C:b/c") None ~__POS__;
646
+
find_prefix (v "C:a/f") (v "C:b/c") None ~__POS__;
647
+
find_prefix (v "C:a/f") (v "C:/b/c") None ~__POS__;
648
+
find_prefix (v "C:\\") (v "C:\\") (Some (v "C:\\")) ~__POS__;
649
+
find_prefix (v "\\\\server\\share\\") (v "\\\\server\\share\\")
650
+
(Some (v "\\\\server\\share\\")) ~__POS__;
651
+
find_prefix (v "\\\\server\\share\\") (v "\\\\server\\share\\a")
652
+
(Some (v "\\\\server\\share\\")) ~__POS__;
653
+
find_prefix (v "\\\\server\\share\\a") (v "\\\\server\\share\\a")
654
+
(Some (v "\\\\server\\share\\a")) ~__POS__;
655
+
find_prefix (v "\\\\server\\share\\a") (v "\\\\server\\share\\b")
656
+
(Some (v "\\\\server\\share\\")) ~__POS__;
657
+
end;
658
+
()
659
+
660
+
let rem_prefix =
661
+
Test.test "Fpath.rem_prefix" @@ fun () ->
662
+
let eq = Test.(eq T.(option (module Fpath))) in
663
+
eq (Fpath.rem_prefix (v "a/b/") (v "a/b")) None ~__POS__;
664
+
eq (Fpath.rem_prefix (v "a/b/") (v "a/b/")) None ~__POS__;
665
+
eq (Fpath.rem_prefix (v "a/b") (v "a/b")) None ~__POS__;
666
+
eq (Fpath.rem_prefix (v "a/b") (v "a/b/")) (Some (v "./")) ~__POS__;
667
+
eq (Fpath.rem_prefix (v "a/b") (v "a/b/c")) (Some (v "c")) ~__POS__;
668
+
eq (Fpath.rem_prefix (v "a/b") (v "a/b/c/")) (Some (v "c/")) ~__POS__;
669
+
eq (Fpath.rem_prefix (v "a/b/") (v "a/b/c")) (Some (v "c")) ~__POS__;
670
+
eq (Fpath.rem_prefix (v "a/b/") (v "a/b/c/")) (Some (v "c/")) ~__POS__;
671
+
eq (Fpath.rem_prefix (v "a/b") (v "a/b")) None ~__POS__;
672
+
eq (Fpath.rem_prefix (v "/a/b/") (v "/a/b")) None ~__POS__;
673
+
eq (Fpath.rem_prefix (v "/a/b/") (v "/a/b/")) None ~__POS__;
674
+
eq (Fpath.rem_prefix (v "/a/b") (v "/a/bc")) None ~__POS__;
675
+
eq (Fpath.rem_prefix (v "/a/b") (v "/a/b")) None ~__POS__;
676
+
eq (Fpath.rem_prefix (v "/a/b/") (v "/a/b")) None ~__POS__;
677
+
eq (Fpath.rem_prefix (v "/a/b") (v "/a/b/")) (Some (v "./")) ~__POS__;
678
+
eq (Fpath.rem_prefix (v "/a/b/") (v "/a/b/")) None ~__POS__;
679
+
eq (Fpath.rem_prefix (v "/a/b") (v "/a/b/c")) (Some (v "c")) ~__POS__;
680
+
eq (Fpath.rem_prefix (v "/a/b/") (v "/a/b/c")) (Some (v "c")) ~__POS__;
681
+
eq (Fpath.rem_prefix (v "a") (v "a/b/c")) (Some (v "b/c")) ~__POS__;
682
+
if windows then begin
683
+
eq (Fpath.rem_prefix (v "C:\\a") (v "C:\\a\\b")) (Some (v "b")) ~__POS__;
684
+
end;
685
+
()
686
+
687
+
let relativize =
688
+
Test.test "Fpath.relativize" @@ fun () ->
689
+
let eq_opt = Test.(eq (T.option (module Fpath))) in
690
+
let relativize ?__POS__:pos root p result =
691
+
Test.block ?__POS__:pos @@ fun () ->
692
+
match Fpath.relativize ~root p with
693
+
| None -> eq_opt None result ~__POS__
694
+
| Some rel as r ->
695
+
eq_opt r result ~__POS__;
696
+
let p = if Fpath.is_current_dir rel then Fpath.to_dir_path p else p in
697
+
eq (Fpath.normalize (Fpath.append root rel)) (Fpath.normalize p)
698
+
~__POS__;
699
+
in
700
+
relativize (v "/a/b") (v "/a/b") (Some (v ".")) ~__POS__;
701
+
relativize (v "/a/b") (v "/a/b/") (Some (v "./")) ~__POS__;
702
+
relativize (v "/a/b/") (v "/a/b/") (Some (v "./")) ~__POS__;
703
+
relativize (v "/a/b/") (v "/a/b") (Some (v "../b")) ~__POS__;
704
+
relativize (v "a/b") (v "a/b") (Some (v ".")) ~__POS__;
705
+
relativize (v "a/b") (v "a/b/") (Some (v "./")) ~__POS__;
706
+
relativize (v "a/b/") (v "a/b/") (Some (v "./")) ~__POS__;
707
+
relativize (v "a/b/") (v "a/b") (Some (v "../b")) ~__POS__;
708
+
relativize (v "a") (v "a") (Some (v ".")) ~__POS__;
709
+
relativize (v "a/") (v "a/") (Some (v "./")) ~__POS__;
710
+
relativize (v "/a/") (v "/a") (Some (v "../a")) ~__POS__;
711
+
relativize (v "/a/") (v "/a/") (Some (v "./")) ~__POS__;
712
+
relativize (v "/a/") (v "/") (Some (v "../")) ~__POS__;
713
+
relativize (v "/a/") (v "/../") (Some (v "../")) ~__POS__;
714
+
relativize (v "/a/") (v "/../c/d") (Some (v "../c/d")) ~__POS__;
715
+
relativize (v "/a/") (v "/../c/d/") (Some (v "../c/d/")) ~__POS__;
716
+
relativize (v "/") (v "/../c/d/") (Some (v "c/d/")) ~__POS__;
717
+
relativize (v "/") (v "/../c/d") (Some (v "c/d")) ~__POS__;
718
+
relativize (v "/") (v "/") (Some (v "./")) ~__POS__;
719
+
relativize (v "/") (v "/a") (Some (v "a")) ~__POS__;
720
+
relativize (v "/") (v "/a/../b") (Some (v "b")) ~__POS__;
721
+
relativize (v "/") (v "/a/../b/") (Some (v "b/")) ~__POS__;
722
+
relativize (v "/a/b/") (v "c") None ~__POS__;
723
+
relativize (v "/a/b/") (v "./") None ~__POS__;
724
+
relativize (v "/a/b/") (v "../") None ~__POS__;
725
+
relativize (v "/a/b/") (v "/c") (Some (v "../../c")) ~__POS__;
726
+
relativize (v "/a/b/") (v "/c/") (Some (v "../../c/")) ~__POS__;
727
+
relativize (v "/a/b/") (v "/c/d/e") (Some (v "../../c/d/e")) ~__POS__;
728
+
relativize (v "/a/b/") (v "/c/d/e/../../f") (Some (v "../../c/f")) ~__POS__;
729
+
relativize (v "/a/b/") (v "/c/d/e/../../f/") (Some (v "../../c/f/")) ~__POS__;
730
+
relativize (v "/a/b/") (v "/./c/d/e/../../f/") (Some (v "../../c/f/"))
731
+
~__POS__;
732
+
relativize (v "/a/b/") (v "/a/b/c") (Some (v "c")) ~__POS__;
733
+
relativize (v "/a/b/") (v "/a/b") (Some (v "../b")) ~__POS__;
734
+
relativize (v "/a/b/") (v "/a/b/") (Some (v "./")) ~__POS__;
735
+
relativize (v "/a/b/c") (v "/d/e/f") (Some (v "../../../d/e/f")) ~__POS__;
736
+
relativize (v "/a/b/c") (v "/a/b/d") (Some (v "../d")) ~__POS__;
737
+
relativize (v "a/b") (v "/c") None ~__POS__;
738
+
relativize (v "a/b") (v "c") (Some (v "../../c")) ~__POS__;
739
+
relativize (v "a/b") (v "../c") (Some (v "../../../c")) ~__POS__;
740
+
relativize (v "a/b") (v "../c/") (Some (v "../../../c/")) ~__POS__;
741
+
relativize (v "a/b") (v "c/") (Some (v "../../c/")) ~__POS__;
742
+
relativize (v "a/b") (v "a/b/c") (Some (v "c")) ~__POS__;
743
+
relativize (v "a/b") (v "a") (Some (v "../../a")) ~__POS__;
744
+
relativize (v "a/b") (v "b") (Some (v "../../b")) ~__POS__;
745
+
relativize (v "a/b") (v "c") (Some (v "../../c")) ~__POS__;
746
+
relativize (v "a/b/c/") (v "a/d") (Some (v "../../d")) ~__POS__;
747
+
relativize (v "a/b/c/") (v "a/b") (Some (v "../../b")) ~__POS__;
748
+
relativize (v "a/b/c/") (v "a/b/../../../") (Some (v "../../../../"))
749
+
~__POS__;
750
+
relativize (v "a/b/c/") (v "a/b/../../../a") (Some (v "../../../../a"))
751
+
~__POS__;
752
+
relativize (v "a/b") (v "a/b/") (Some (v "./")) ~__POS__;
753
+
relativize (v "../") (v "./") None ~__POS__;
754
+
relativize (v "../a") (v "b") None ~__POS__;
755
+
relativize (v "../../a") (v "../b") None ~__POS__;
756
+
relativize (v "../a") (v "../b/c") (Some (v "../b/c")) ~__POS__;
757
+
relativize (v "../a") (v "../../b") (Some (v "../../b")) ~__POS__;
758
+
relativize (v "a") (v "../../b") (Some (v "../../../b")) ~__POS__;
759
+
relativize (v "a/c") (v "../../b") (Some (v "../../../../b")) ~__POS__;
760
+
if windows then begin
761
+
relativize (v "C:a\\c") (v "C:..\\..\\b") (Some (v "..\\..\\..\\..\\b"))
762
+
~__POS__;
763
+
relativize (v "C:a\\c") (v "..\\..\\b") None ~__POS__;
764
+
relativize (v "\\\\?\\UNC\\server\\share\\a\\b\\c")
765
+
(v "\\\\?\\UNC\\server\\share\\d\\e\\f") (Some (v "../../../d/e/f"))
766
+
~__POS__;
767
+
end;
768
+
()
769
+
770
+
let is_rooted =
771
+
Test.test "Fpath.is_rooted" @@ fun () ->
772
+
Test.bool (Fpath.is_rooted ~root:(v "a/b") (v "a/b")) false ~__POS__;
773
+
Test.bool (Fpath.is_rooted ~root:(v "a/b") (v "a/b/")) true ~__POS__;
774
+
Test.bool (Fpath.is_rooted ~root:(v "a/b/") (v "a/b")) false ~__POS__;
775
+
Test.bool (Fpath.is_rooted ~root:(v "a/b/") (v "a/b/")) true ~__POS__;
776
+
Test.bool (Fpath.is_rooted ~root:(v "./") (v "a")) true ~__POS__;
777
+
Test.bool (Fpath.is_rooted ~root:(v "./") (v "a/")) true ~__POS__;
778
+
Test.bool (Fpath.is_rooted ~root:(v "./") (v "a/../")) true ~__POS__;
779
+
Test.bool (Fpath.is_rooted ~root:(v "./") (v "..")) false ~__POS__;
780
+
Test.bool (Fpath.is_rooted ~root:(v "../") (v "./")) false ~__POS__;
781
+
Test.bool (Fpath.is_rooted ~root:(v "../") (v "a")) false ~__POS__;
782
+
Test.bool (Fpath.is_rooted ~root:(v "../") (v "../a")) true ~__POS__;
783
+
Test.bool (Fpath.is_rooted ~root:(v "../a") (v "./")) false ~__POS__;
784
+
Test.bool (Fpath.is_rooted ~root:(v "/a") (v "/a/..")) false ~__POS__;
785
+
Test.bool (Fpath.is_rooted ~root:(v "/a") (v "/a/../a/")) true ~__POS__;
786
+
Test.bool (Fpath.is_rooted ~root:(v "/a") (v "/a/../a")) false ~__POS__;
787
+
Test.bool (Fpath.is_rooted ~root:(v "/") (v "/..")) true ~__POS__;
788
+
()
789
+
790
+
let is_abs_rel =
791
+
Test.test "Fpath.is_abs_rel" @@ fun () ->
792
+
let is_abs ?__POS__:pos bool p =
793
+
Test.block ?__POS__:pos @@ fun () ->
794
+
let p = v p in
795
+
Test.bool (Fpath.is_abs p) bool ~__POS__;
796
+
Test.bool (Fpath.is_rel p) (not bool) ~__POS__;
797
+
in
798
+
is_abs true "/a/b/c" ~__POS__;
799
+
if not windows then is_abs true "//a/b/c" ~__POS__;
800
+
is_abs false "." ~__POS__;
801
+
is_abs false ".." ~__POS__;
802
+
is_abs false "../" ~__POS__;
803
+
is_abs false "a" ~__POS__;
804
+
is_abs false "a/b" ~__POS__;
805
+
is_abs true "/" ~__POS__;
806
+
if windows then begin
807
+
is_abs false "C:." ~__POS__;
808
+
is_abs true "C:\\" ~__POS__;
809
+
is_abs true "C:/" ~__POS__;
810
+
is_abs false "C:bli/bla" ~__POS__;
811
+
is_abs false "C:bli/bla" ~__POS__;
812
+
is_abs false "C:rel" ~__POS__;
813
+
is_abs true "\\\\server\\share\\" ~__POS__;
814
+
is_abs true "\\\\?\\a:\\" ~__POS__;
815
+
is_abs true "\\\\?\\a:\\c" ~__POS__;
816
+
is_abs true "\\\\?\\server\\share\\" ~__POS__;
817
+
is_abs true "\\\\?\\server\\share\\a" ~__POS__;
818
+
is_abs true "\\\\?\\UNC\\server\\share\\" ~__POS__;
819
+
is_abs true "\\\\?\\UNC\\server\\share\\a" ~__POS__;
820
+
is_abs true "\\\\.\\device\\" ~__POS__;
821
+
is_abs true "\\\\.\\device\\a" ~__POS__;
822
+
end;
823
+
()
824
+
825
+
let is_root =
826
+
Test.test "Fpath.is_root" @@ fun () ->
827
+
Test.bool (Fpath.is_root (v "/")) true ~__POS__;
828
+
Test.bool (Fpath.is_root (v "/..")) false ~__POS__;
829
+
Test.bool (Fpath.is_root (v "/.")) false ~__POS__;
830
+
Test.bool (Fpath.is_root (v "/a")) false ~__POS__;
831
+
Test.bool (Fpath.is_root (v "/a/..")) false ~__POS__;
832
+
Test.bool (Fpath.is_root (v "a")) false ~__POS__;
833
+
Test.bool (Fpath.is_root (v ".")) false ~__POS__;
834
+
Test.bool (Fpath.is_root (v "..")) false ~__POS__;
835
+
if not windows then (Test.bool (Fpath.is_root (v "//")) true ~__POS__);
836
+
if windows then begin
837
+
Test.bool (Fpath.is_root (v "\\\\.\\dev\\")) true ~__POS__;
838
+
Test.bool (Fpath.is_root (v "\\\\.\\dev\\..")) false ~__POS__;
839
+
Test.bool (Fpath.is_root (v "\\\\.\\dev\\a")) false ~__POS__;
840
+
Test.bool (Fpath.is_root (v "\\\\server\\share\\")) true ~__POS__;
841
+
Test.bool (Fpath.is_root (v "\\\\server\\share\\a")) false ~__POS__;
842
+
Test.bool (Fpath.is_root (v "C:\\")) true ~__POS__;
843
+
Test.bool (Fpath.is_root (v "C:a")) false ~__POS__;
844
+
Test.bool (Fpath.is_root (v "C:\\a")) false ~__POS__;
845
+
end;
846
+
()
847
+
848
+
let is_current_dir =
849
+
Test.test "Fpath.is_current_dir" @@ fun () ->
850
+
Test.bool (Fpath.is_current_dir (v ".")) true ~__POS__;
851
+
Test.bool (Fpath.is_current_dir ~prefix:true (v ".")) true ~__POS__;
852
+
Test.bool (Fpath.is_current_dir (v "./")) true ~__POS__;
853
+
Test.bool (Fpath.is_current_dir ~prefix:true (v "./")) true ~__POS__;
854
+
Test.bool (Fpath.is_current_dir (v "./a/..")) false ~__POS__;
855
+
Test.bool (Fpath.is_current_dir ~prefix:true (v "./a/..")) true ~__POS__;
856
+
Test.bool (Fpath.is_current_dir (v "/.")) false ~__POS__;
857
+
if windows then begin
858
+
Test.bool (Fpath.is_current_dir (v "\\\\.\\dev\\.")) false ~__POS__;
859
+
Test.bool (Fpath.is_current_dir ~prefix:true (v "\\\\.\\dev\\.")) false
860
+
~__POS__;
861
+
Test.bool (Fpath.is_current_dir (v "\\\\.\\dev\\.\\")) false ~__POS__;
862
+
Test.bool (Fpath.is_current_dir (v "\\\\server\\share\\.")) false ~__POS__;
863
+
Test.bool (Fpath.is_current_dir (v "\\\\server\\share\\.\\")) false
864
+
~__POS__;
865
+
Test.bool (Fpath.is_current_dir (v "C:.")) true ~__POS__;
866
+
Test.bool (Fpath.is_current_dir ~prefix:true (v "C:.")) true ~__POS__;
867
+
Test.bool (Fpath.is_current_dir (v "C:./")) true ~__POS__;
868
+
Test.bool (Fpath.is_current_dir ~prefix:true (v "C:./")) true ~__POS__;
869
+
Test.bool (Fpath.is_current_dir (v "C:./a/..")) false ~__POS__;
870
+
Test.bool (Fpath.is_current_dir ~prefix:true (v "C:./a/..")) true ~__POS__;
871
+
end;
872
+
()
873
+
874
+
let is_parent_dir =
875
+
Test.test "Fpath.is_parent_dir" @@ fun () ->
876
+
Test.bool (Fpath.is_parent_dir (v ".")) false ~__POS__;
877
+
Test.bool (Fpath.is_parent_dir (v "./")) false ~__POS__;
878
+
Test.bool (Fpath.is_parent_dir (v "..")) true ~__POS__;
879
+
Test.bool (Fpath.is_parent_dir ~prefix:true (v "..")) true ~__POS__;
880
+
Test.bool (Fpath.is_parent_dir (v "../")) true ~__POS__;
881
+
Test.bool (Fpath.is_parent_dir ~prefix:true (v "../")) true ~__POS__;
882
+
Test.bool (Fpath.is_parent_dir (v "./a/../..")) false ~__POS__;
883
+
Test.bool (Fpath.is_parent_dir ~prefix:true (v "../a/../..")) true ~__POS__;
884
+
Test.bool (Fpath.is_parent_dir (v "../..")) false ~__POS__;
885
+
Test.bool (Fpath.is_parent_dir (v "/..")) false ~__POS__;
886
+
if windows then begin
887
+
Test.bool (Fpath.is_parent_dir (v "\\\\.\\dev\\.")) false ~__POS__;
888
+
Test.bool (Fpath.is_parent_dir (v "\\\\.\\dev\\.\\")) false ~__POS__;
889
+
Test.bool (Fpath.is_parent_dir (v "\\\\server\\share\\.")) false ~__POS__;
890
+
Test.bool (Fpath.is_parent_dir (v "\\\\server\\share\\.\\")) false ~__POS__;
891
+
Test.bool (Fpath.is_parent_dir (v "C:..")) true ~__POS__;
892
+
Test.bool (Fpath.is_parent_dir (v "C:../")) true ~__POS__;
893
+
Test.bool (Fpath.is_parent_dir (v "C:../a/..")) false ~__POS__;
894
+
Test.bool (Fpath.is_parent_dir ~prefix:true (v "C:../a/..")) true ~__POS__;
895
+
end;
896
+
()
897
+
898
+
let is_dotfile =
899
+
Test.test "Fpath.is_dotfile" @@ fun () ->
900
+
Test.bool (Fpath.is_dotfile (v ".")) false ~__POS__;
901
+
Test.bool (Fpath.is_dotfile (v "..")) false ~__POS__;
902
+
Test.bool (Fpath.is_dotfile (v "a/.")) false ~__POS__;
903
+
Test.bool (Fpath.is_dotfile (v "a/..")) false ~__POS__;
904
+
Test.bool (Fpath.is_dotfile (v "/a/.")) false ~__POS__;
905
+
Test.bool (Fpath.is_dotfile (v "/a/..")) false ~__POS__;
906
+
Test.bool (Fpath.is_dotfile (v "...")) true ~__POS__;
907
+
Test.bool (Fpath.is_dotfile (v ".../")) true ~__POS__;
908
+
Test.bool (Fpath.is_dotfile (v "a/...")) true ~__POS__;
909
+
Test.bool (Fpath.is_dotfile (v "a/.../")) true ~__POS__;
910
+
Test.bool (Fpath.is_dotfile (v "/a/...")) true ~__POS__;
911
+
Test.bool (Fpath.is_dotfile (v "/a/.../")) true ~__POS__;
912
+
Test.bool (Fpath.is_dotfile (v "/a/.../a")) false ~__POS__;
913
+
if windows then begin
914
+
Test.bool (Fpath.is_dotfile (v "\\\\.\\dev\\.")) false ~__POS__;
915
+
Test.bool (Fpath.is_dotfile (v "\\\\.\\dev\\.\\")) false ~__POS__;
916
+
Test.bool (Fpath.is_dotfile (v "\\\\server\\share\\.")) false ~__POS__;
917
+
Test.bool (Fpath.is_dotfile (v "\\\\server\\share\\.\\")) false ~__POS__;
918
+
Test.bool (Fpath.is_dotfile (v "C:.")) false ~__POS__;
919
+
Test.bool (Fpath.is_dotfile (v "C:./")) false ~__POS__;
920
+
Test.bool (Fpath.is_dotfile (v "C:./a/..")) false ~__POS__;
921
+
Test.bool (Fpath.is_dotfile (v "C:..")) false ~__POS__;
922
+
Test.bool (Fpath.is_dotfile (v "C:../")) false ~__POS__;
923
+
Test.bool (Fpath.is_dotfile (v "C:../a/..")) false ~__POS__;
924
+
Test.bool (Fpath.is_dotfile (v "C:../a/...")) true ~__POS__;
925
+
Test.bool (Fpath.is_dotfile (v "C:...")) true ~__POS__;
926
+
end;
927
+
()
928
+
929
+
let get_ext =
930
+
Test.test "Fpath.get_ext" @@ fun () ->
931
+
let eq_ext ?__POS__:pos ?multi p e =
932
+
Test.block ?__POS__:pos @@ fun () ->
933
+
let p = Fpath.v p in
934
+
Test.string (Fpath.get_ext ?multi p) e ~__POS__;
935
+
Test.string Fpath.(get_ext ?multi (to_dir_path p)) e ~__POS__;
936
+
in
937
+
eq_ext "/" "" ~__POS__;
938
+
eq_ext "a/b" "" ~__POS__;
939
+
eq_ext "a/b.mli/.." "" ~__POS__;
940
+
eq_ext "a/b.mli/..." "" ~__POS__;
941
+
eq_ext "a/b." "." ~__POS__;
942
+
eq_ext "a/b.mli" ".mli" ~__POS__;
943
+
eq_ext ~multi:true "a/b.mli" ".mli" ~__POS__;
944
+
eq_ext "a/b.mli/" ".mli" ~__POS__;
945
+
eq_ext "a/.ocamlinit" "" ~__POS__;
946
+
eq_ext "a.tar.gz" ".gz" ~__POS__;
947
+
eq_ext ~multi:true "a.tar.gz" ".tar.gz" ~__POS__;
948
+
eq_ext "a/.emacs.d" ".d" ~__POS__;
949
+
eq_ext "a/.emacs.d/" ".d" ~__POS__;
950
+
eq_ext ~multi:true "a/.emacs.d" ".d" ~__POS__;
951
+
eq_ext "." "" ~__POS__;
952
+
eq_ext ".." "" ~__POS__;
953
+
eq_ext "..." "" ~__POS__;
954
+
eq_ext "...." "" ~__POS__;
955
+
eq_ext "....." "" ~__POS__;
956
+
eq_ext ".a" "" ~__POS__;
957
+
eq_ext ".a." "." ~__POS__;
958
+
eq_ext ".a.." "." ~__POS__;
959
+
eq_ext ".a..." "." ~__POS__;
960
+
eq_ext ".a...." "." ~__POS__;
961
+
eq_ext "a/..." "" ~__POS__;
962
+
eq_ext "a.mli/." "" ~__POS__;
963
+
eq_ext "a.mli/.." "" ~__POS__;
964
+
eq_ext "a/.a" "" ~__POS__;
965
+
eq_ext "a/..b" "" ~__POS__;
966
+
eq_ext "a/..b.a" ".a" ~__POS__;
967
+
eq_ext "a/..b..ac" ".ac" ~__POS__;
968
+
eq_ext "/a/b" "" ~__POS__;
969
+
eq_ext "/a/b." "." ~__POS__;
970
+
eq_ext "./a." "." ~__POS__;
971
+
eq_ext "./a.." "." ~__POS__;
972
+
eq_ext "./.a." "." ~__POS__;
973
+
eq_ext ~multi:true "." "" ~__POS__;
974
+
eq_ext ~multi:true ".." "" ~__POS__;
975
+
eq_ext ~multi:true "..." "" ~__POS__;
976
+
eq_ext ~multi:true "...." "" ~__POS__;
977
+
eq_ext ~multi:true "....." "" ~__POS__;
978
+
eq_ext ~multi:true ".a" "" ~__POS__;
979
+
eq_ext ~multi:true ".a." "." ~__POS__;
980
+
eq_ext ~multi:true ".a.." ".." ~__POS__;
981
+
eq_ext ~multi:true ".a..." "..." ~__POS__;
982
+
eq_ext ~multi:true ".a...." "...." ~__POS__;
983
+
eq_ext ~multi:true "a/..." "" ~__POS__;
984
+
eq_ext ~multi:true "a/.a" "" ~__POS__;
985
+
eq_ext ~multi:true "a/.." "" ~__POS__;
986
+
eq_ext ~multi:true "a/..b" "" ~__POS__;
987
+
eq_ext ~multi:true "a/..b.a" ".a" ~__POS__;
988
+
eq_ext ~multi:true "a/..b..ac" "..ac" ~__POS__;
989
+
eq_ext ~multi:true "a/.emacs.d" ".d" ~__POS__;
990
+
eq_ext ~multi:true "/a/b.mli" ".mli" ~__POS__;
991
+
eq_ext ~multi:true "a.tar.gz" ".tar.gz" ~__POS__;
992
+
eq_ext ~multi:true "./a." "." ~__POS__;
993
+
eq_ext ~multi:true "./a.." ".." ~__POS__;
994
+
eq_ext ~multi:true "./.a." "." ~__POS__;
995
+
eq_ext ~multi:true "./.a.." ".." ~__POS__;
996
+
()
997
+
998
+
let has_ext =
999
+
Test.test "Fpath.has_ext" @@ fun () ->
1000
+
let has_ext ?__POS__:pos e p bool =
1001
+
Test.block ?__POS__:pos @@ fun () ->
1002
+
let p = Fpath.v p in
1003
+
Test.bool (Fpath.has_ext e p) bool ~__POS__;
1004
+
Test.bool (Fpath.has_ext e (Fpath.to_dir_path p)) bool ~__POS__;
1005
+
in
1006
+
has_ext "mli" "a/b.mli" true ~__POS__;
1007
+
has_ext ".mli" "a/b.mli" true ~__POS__;
1008
+
has_ext ".mli" "a/b.mli/" true ~__POS__;
1009
+
has_ext ".mli" "a/bmli" false ~__POS__;
1010
+
has_ext ".tar.gz" "a/f.tar.gz" true ~__POS__;
1011
+
has_ext "tar.gz" "a/f.tar.gz" true ~__POS__;
1012
+
has_ext ".gz" "a/f.tar.gz" true ~__POS__;
1013
+
has_ext ".tar" "a/f.tar.gz" false ~__POS__;
1014
+
has_ext ".cache" "a/.cache" false ~__POS__;
1015
+
has_ext "" "a/b" false ~__POS__;
1016
+
has_ext "" "a/b." true ~__POS__;
1017
+
has_ext "." "a/b." true ~__POS__;
1018
+
has_ext "." "." false ~__POS__;
1019
+
has_ext "." ".." false ~__POS__;
1020
+
has_ext "." "..." false ~__POS__;
1021
+
has_ext "." "...a" false ~__POS__;
1022
+
has_ext "." "...a." true ~__POS__;
1023
+
has_ext "." "...a.." true ~__POS__;
1024
+
has_ext ".." "...a.." true ~__POS__;
1025
+
has_ext ".." "...a.." true ~__POS__;
1026
+
has_ext "" "." false ~__POS__;
1027
+
has_ext "" ".." false ~__POS__;
1028
+
has_ext "" "..." false ~__POS__;
1029
+
has_ext "" "...a" false ~__POS__;
1030
+
has_ext "" "...a." true ~__POS__;
1031
+
has_ext "" "...a.." true ~__POS__;
1032
+
has_ext ".." "." false ~__POS__;
1033
+
has_ext ".." ".." false ~__POS__;
1034
+
has_ext ".." "..a." false ~__POS__;
1035
+
has_ext ".." "..a.." true ~__POS__;
1036
+
has_ext ".." "..." false ~__POS__;
1037
+
has_ext ".." "...a." false ~__POS__;
1038
+
has_ext ".." "...a.." true ~__POS__;
1039
+
has_ext "..." ".." false ~__POS__;
1040
+
has_ext "..." "..." false ~__POS__;
1041
+
has_ext "..." "...." false ~__POS__;
1042
+
has_ext "..." ".a..." true ~__POS__;
1043
+
has_ext "tar.gz" "a/ftar.gz" false ~__POS__;
1044
+
has_ext "tar.gz" "a/tar.gz" false ~__POS__;
1045
+
has_ext "tar.gz" "a/.tar.gz" false ~__POS__;
1046
+
has_ext ".tar" "a/f.tar.gz" false ~__POS__;
1047
+
has_ext ".ocamlinit" ".ocamlinit" false ~__POS__;
1048
+
has_ext ".ocamlinit/" ".ocamlinit" false ~__POS__;
1049
+
has_ext ".ocamlinit" "..ocamlinit" false ~__POS__;
1050
+
has_ext "..ocamlinit" "...ocamlinit" false ~__POS__;
1051
+
has_ext "..ocamlinit" ".a..ocamlinit" true ~__POS__;
1052
+
has_ext "..a" ".." false ~__POS__;
1053
+
()
1054
+
1055
+
let exists_ext =
1056
+
Test.test "Fpath.exists_ext" @@ fun () ->
1057
+
let exists_ext ?__POS__:pos ?multi p bool =
1058
+
Test.block ?__POS__:pos @@ fun () ->
1059
+
let p = Fpath.v p in
1060
+
Test.bool (Fpath.exists_ext ?multi p) bool ~__POS__;
1061
+
Test.bool (Fpath.exists_ext ?multi (Fpath.to_dir_path p)) bool ~__POS__;
1062
+
in
1063
+
exists_ext "a/f" false ~__POS__;
1064
+
exists_ext "a/f." true ~__POS__;
1065
+
exists_ext "a/f.gz" true ~__POS__;
1066
+
exists_ext ~multi:true "a/f.gz" false ~__POS__;
1067
+
exists_ext "a/f.tar.gz" true ~__POS__;
1068
+
exists_ext ~multi:true "a/f.tar.gz" true ~__POS__;
1069
+
exists_ext "a/f.tar.gz/" true ~__POS__;
1070
+
exists_ext ".emacs.d" true ~__POS__;
1071
+
exists_ext ".emacs.d/" true ~__POS__;
1072
+
exists_ext ~multi:true ".emacs.d/" false ~__POS__;
1073
+
exists_ext ~multi:true "..emacs.d/" false ~__POS__;
1074
+
exists_ext ~multi:true "..emacs..d/" true ~__POS__;
1075
+
exists_ext ".ocamlinit" false ~__POS__;
1076
+
exists_ext ~multi:true "a/.a.." true ~__POS__;
1077
+
exists_ext "a/.a." true ~__POS__;
1078
+
exists_ext "a/..." false ~__POS__;
1079
+
exists_ext "a/.." false ~__POS__;
1080
+
exists_ext "a/." false ~__POS__;
1081
+
()
1082
+
1083
+
let add_ext =
1084
+
Test.test "Fpath.add_ext" @@ fun () ->
1085
+
Test.invalid_arg (fun () -> Fpath.add_ext "/" (v "a/b/c"));
1086
+
let eq_add_ext ?__POS__:pos ext p p' =
1087
+
Test.block ?__POS__:pos @@ fun () ->
1088
+
let p, p' = Fpath.v p, Fpath.v p' in
1089
+
eq (Fpath.add_ext ext p) p' ~__POS__;
1090
+
eq
1091
+
(Fpath.add_ext ext (Fpath.to_dir_path p)) (Fpath.to_dir_path p') ~__POS__;
1092
+
in
1093
+
eq_add_ext "mli" "a/b" "a/b.mli" ~__POS__;
1094
+
eq_add_ext ".mli" "a/b" "a/b.mli" ~__POS__;
1095
+
eq_add_ext ".mli" "a/b/" "a/b.mli/" ~__POS__;
1096
+
eq_add_ext ".mli" "/" "/" ~__POS__;
1097
+
eq_add_ext ".mli" "a/b/.." "a/b/.." ~__POS__;
1098
+
eq_add_ext "." "a/b" "a/b." ~__POS__;
1099
+
eq_add_ext "" "a/b" "a/b" ~__POS__;
1100
+
eq_add_ext "tar.gz" "a/f" "a/f.tar.gz" ~__POS__;
1101
+
eq_add_ext ".tar.gz" "a/f" "a/f.tar.gz" ~__POS__;
1102
+
eq_add_ext "gz" "a/f.tar" "a/f.tar.gz" ~__POS__;
1103
+
eq_add_ext ".gz" "a/f.tar" "a/f.tar.gz" ~__POS__;
1104
+
eq_add_ext "" "/" "/" ~__POS__;
1105
+
eq_add_ext "a" "/" "/" ~__POS__;
1106
+
eq_add_ext ".a" "/" "/" ~__POS__;
1107
+
()
1108
+
1109
+
let rem_ext =
1110
+
Test.test "Fpath.rem_ext" @@ fun () ->
1111
+
let eq_rem_ext ?__POS__:pos ?multi p p' =
1112
+
Test.block ?__POS__:pos @@ fun () ->
1113
+
let p, p' = Fpath.v p, Fpath.v p' in
1114
+
eq (Fpath.rem_ext ?multi p) p' ~__POS__;
1115
+
eq (Fpath.rem_ext ?multi (Fpath.to_dir_path p)) (Fpath.to_dir_path p')
1116
+
~__POS__;
1117
+
in
1118
+
eq_rem_ext "/" "/" ~__POS__;
1119
+
eq_rem_ext "/a/b" "/a/b" ~__POS__;
1120
+
eq_rem_ext "/a/b.mli" "/a/b" ~__POS__;
1121
+
eq_rem_ext "/a/b.mli/" "/a/b/" ~__POS__;
1122
+
eq_rem_ext "/a/b.mli/.." "/a/b.mli/.." ~__POS__;
1123
+
eq_rem_ext "/a/b.mli/." "/a/b.mli/." ~__POS__;
1124
+
eq_rem_ext "a/.ocamlinit" "a/.ocamlinit" ~__POS__;
1125
+
eq_rem_ext ~multi:true "a/.ocamlinit" "a/.ocamlinit" ~__POS__;
1126
+
eq_rem_ext "a/.emacs.d" "a/.emacs" ~__POS__;
1127
+
eq_rem_ext "f.tar.gz" "f.tar" ~__POS__;
1128
+
eq_rem_ext ~multi:true "f.tar.gz" "f" ~__POS__;
1129
+
eq_rem_ext ~multi:true "f.tar.gz/" "f/" ~__POS__;
1130
+
eq_rem_ext "a/..." "a/..." ~__POS__;
1131
+
eq_rem_ext "a/..a." "a/..a" ~__POS__;
1132
+
eq_rem_ext "a/..a.." "a/..a." ~__POS__;
1133
+
eq_rem_ext ~multi:true "a/..a.." "a/..a" ~__POS__;
1134
+
eq_rem_ext ".tar.gz" ".tar" ~__POS__;
1135
+
eq_rem_ext ~multi:true "a/.tar.gz" "a/.tar" ~__POS__;
1136
+
eq_rem_ext ~multi:true ".tar" ".tar" ~__POS__;
1137
+
eq_rem_ext ~multi:true "/.tar" "/.tar" ~__POS__;
1138
+
()
1139
+
1140
+
let set_ext =
1141
+
Test.test "Fpath.set_ext" @@ fun () ->
1142
+
Test.invalid_arg ~__POS__ (fun () -> (Fpath.set_ext "/") (v "a/b/c"));
1143
+
let eq_set_ext ?__POS__:pos ?multi ext p p' =
1144
+
Test.block ?__POS__:pos @@ fun () ->
1145
+
let p, p' = Fpath.v p, Fpath.v p' in
1146
+
eq (Fpath.set_ext ?multi ext p) p' ~__POS__;
1147
+
eq (Fpath.set_ext ?multi ext (Fpath.to_dir_path p)) (Fpath.to_dir_path p')
1148
+
~__POS__;
1149
+
in
1150
+
eq_set_ext ".bla" "/a/b" "/a/b.bla" ~__POS__;
1151
+
eq_set_ext "bla" "/a/b" "/a/b.bla" ~__POS__;
1152
+
eq_set_ext ".bla" "/a/b.mli" "/a/b.bla" ~__POS__;
1153
+
eq_set_ext "bla" "/a/b.mli" "/a/b.bla" ~__POS__;
1154
+
eq_set_ext "bla" "a/.ocamlinit" "a/.ocamlinit.bla" ~__POS__;
1155
+
eq_set_ext "bla" "a/.emacs.d" "a/.emacs.bla" ~__POS__;
1156
+
eq_set_ext "bla" "f.tar.gz" "f.tar.bla" ~__POS__;
1157
+
eq_set_ext ~multi:true "bla" "f.tar.gz" "f.bla" ~__POS__;
1158
+
eq_set_ext ~multi:true "" "f.tar.gz" "f" ~__POS__;
1159
+
()
1160
+
1161
+
let split_ext =
1162
+
Test.test "Fpath.split_ext" @@ fun () ->
1163
+
let eq_split ?__POS__:pos ?multi p q ext =
1164
+
Test.block ?__POS__:pos @@ fun () ->
1165
+
let p, q = Fpath.v p, Fpath.v q in
1166
+
let check ?__POS__:pos p q =
1167
+
Test.block ?__POS__:pos @@ fun () ->
1168
+
let q', ext' = Fpath.split_ext ?multi p in
1169
+
Test.string ext ext' ~__POS__;
1170
+
eq q q' ~__POS__;
1171
+
eq p (Fpath.add_ext ext q') ~__POS__;
1172
+
in
1173
+
check p q ~__POS__;
1174
+
check (Fpath.to_dir_path p) (Fpath.to_dir_path q) ~__POS__;
1175
+
in
1176
+
eq_split "/a/b" "/a/b" "" ~__POS__;
1177
+
eq_split "/a/b.mli" "/a/b" ".mli" ~__POS__;
1178
+
eq_split "a/.ocamlinit" "a/.ocamlinit" "" ~__POS__;
1179
+
eq_split "f.tar.gz" "f.tar" ".gz" ~__POS__;
1180
+
eq_split ~multi:true "f.tar.gz" "f" ".tar.gz" ~__POS__;
1181
+
eq_split ~multi:true ".tar" ".tar" "" ~__POS__;
1182
+
eq_split ~multi:true "/.tar" "/.tar" "" ~__POS__;
1183
+
eq_split ~multi:true "/.tar.gz" "/.tar" ".gz" ~__POS__;
1184
+
eq_split ~multi:true "/.tar.gz/.." "/.tar.gz/.." "" ~__POS__;
1185
+
()
1186
+
1187
+
let main () = Test.main @@ fun () -> Test.autorun ()
1188
+
let () = if !Sys.interactive then () else exit (main ())