unikernel/duniverse/fpath/.gitignore

@@ -0,0 +1,9 @@
+_build
+tmp
+*~
+\.\#*
+\#*#
+*.native
+*.byte
+*.install
+_b0

unikernel/duniverse/fpath/.merlin

@@ -0,0 +1,4 @@
+PKG astring result
+S src
+S test
+B _build/**

unikernel/duniverse/fpath/.ocp-indent

@@ -0,0 +1 @@
+strict_with=always,match_clause=4,strict_else=never

unikernel/duniverse/fpath/CHANGES.md

@@ -0,0 +1,25 @@
+v0.7.3 2020-09-08 Zagreb
+------------------------
+
+- Require OCaml 4.03 and drop `result` compatibility package
+- Support OCaml 4.12 injectiviy annotation of Map.S (#18).
+  Thanks to Kate for the patch. 
+
+v0.7.2 2017-05-04 La Forclaz (VS)
+---------------------------------
+
+- Fix `odoc` documentation generation.
+- Document the error message of `Fpath.of_string` so that
+  client can rely and build on it.
+
+v0.7.1 2016-07-12 Cambridge (UK)
+--------------------------------
+
+- Add `Fpath.mem_ext`.
+- Documentation fixes.
+
+
+v0.7.0 2016-05-23 La Forclaz (VS)
+---------------------------------
+
+First release. Many thanks to David Sheets for his review of the API.

unikernel/duniverse/fpath/LICENSE.md

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

unikernel/duniverse/fpath/README.md

@@ -0,0 +1,32 @@
+Fpath — File system paths for OCaml
+-------------------------------------------------------------------------------
+%%VERSION%%
+
+Fpath is an OCaml module for handling file system paths with POSIX or
+Windows conventions. Fpath processes paths without accessing the file
+system and is independent from any system library.
+
+Fpath depends on [Astring][astring] and is distributed under the ISC
+license.
+
+[astring]: http://erratique.ch/software/astring
+
+Home page: http://erratique.ch/software/fpath  
+
+## Installation
+
+Fpath can be installed with `opam`:
+
+    opam install fpath
+
+If you don't use `opam` consult the [`opam`](opam) file for build
+instructions.
+
+## Documentation
+
+The documentation and API reference is automatically generated by
+`ocamldoc` from the interfaces. It can be consulted [online][doc]
+and there is a generated version in the `doc` directory of the
+distribution.
+
+[doc]: http://erratique.ch/software/fpath/doc/

unikernel/duniverse/fpath/_tags

@@ -0,0 +1,5 @@
+true : bin_annot, safe_string, package(astring)
+<_b0> : -traverse
+<src> : include
+<src/fpath_top*> : package(compiler-libs.toplevel)
+<test> : include

unikernel/duniverse/fpath/doc/index.mld

@@ -0,0 +1,11 @@
+{0 Fpath {%html: <span class="version">%%VERSION%%</span>%}}
+
+Fpath handles file system paths with POSIX or Windows conventions. It
+processes paths without accessing the file system and is independent
+from any system library.
+
+{1:api API}
+
+{!modules:
+Fpath
+}

unikernel/duniverse/fpath/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.0)
+(name fpath)

unikernel/duniverse/fpath/fpath.opam

@@ -0,0 +1,28 @@
+opam-version: "2.0"
+maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
+authors: ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
+homepage: "http://erratique.ch/software/fpath"
+doc: "http://erratique.ch/software/fpath/doc"
+dev-repo: "git+https://github.com/dune-universe/fpath.git"
+bug-reports: "https://github.com/dbuenzli/fpath/issues"
+tags: [ "file" "system" "path" "org:erratique" ]
+license: "ISC"
+depends: [
+  "dune"
+  "ocaml" {>= "4.03.0"}
+  "astring"
+]
+synopsis: "File system paths for OCaml"
+description: """
+Fpath is an OCaml module for handling file system paths with POSIX or
+Windows conventions. Fpath processes paths without accessing the file
+system and is independent from any system library.
+
+Fpath depends on [Astring][astring] and is distributed under the ISC
+license.
+
+[astring]: http://erratique.ch/software/astring"""
+build: [[ "dune" "build" "-p" name ]]
+url {
+  src: "git://github.com/dune-universe/fpath.git#duniverse-v0.7.3"
+}

unikernel/duniverse/fpath/pkg/META

@@ -0,0 +1,17 @@
+description = "File system paths for OCaml"
+version = "%%VERSION_NUM%%"
+requires = "astring"
+archive(byte) = "fpath.cma"
+archive(native) = "fpath.cmxa"
+plugin(byte) = "fpath.cma"
+plugin(native) = "fpath.cmxs"
+
+package "top" (
+  description = "Fpath toplevel support"
+  version = "%%VERSION_NUM%%"
+  requires = "astring.top fpath"
+  archive(byte) = "fpath_top.cma"
+  archive(native) = "fpath_top.cmxa"
+  plugin(byte) = "fpath_top.cma"
+  plugin(native) = "fpath_top.cmxs"
+)

unikernel/duniverse/fpath/pkg/pkg.ml

@@ -0,0 +1,11 @@
+#!/usr/bin/env ocaml
+#use "topfind"
+#require "topkg"
+open Topkg
+
+let () =
+  Pkg.describe "fpath" @@ fun c ->
+  Ok [ Pkg.mllib ~api:["Fpath"] "src/fpath.mllib";
+       Pkg.mllib ~api:[] "src/fpath_top.mllib";
+       Pkg.lib "src/fpath_top_init.ml";
+       Pkg.test "test/test"; ]

unikernel/duniverse/fpath/src/dune

@@ -0,0 +1,14 @@
+(library
+ (name fpath)
+ (public_name fpath)
+ (libraries astring result)
+ (modules fpath)
+ (flags :standard -w -6-27-32-33-39)
+ (wrapped false))
+
+(library
+ (name fpath_top)
+ (public_name fpath.top)
+ (libraries compiler-libs.toplevel astring.top)
+ (modules fpath_top)
+ (wrapped false))

unikernel/duniverse/fpath/src/fpath.ml

@@ -0,0 +1,781 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+   %%NAME%% %%VERSION%%
+  ---------------------------------------------------------------------------*)
+
+open Astring
+
+(* Unsafe string and byte manipulations. If you don't believe the
+   author's invariants, replacing with safe versions makes everything
+   safe in the library. He won't be upset. *)
+
+let bytes_unsafe_set = Bytes.unsafe_set
+let string_unsafe_get = String.unsafe_get
+
+(* Errors *)
+
+let err_invalid_seg s = strf "%a: invalid segment" String.dump s
+let err_invalid_ext s = strf "%a: invalid extension" String.dump s
+
+(* A few useful constants *)
+
+let windows = Sys.os_type = "Win32"
+let dir_sep_char = if windows then '\\' else '/'
+let dir_sep = String.of_char dir_sep_char
+let dir_sep_sub = String.sub dir_sep
+let not_dir_sep c = c <> dir_sep_char
+
+let dot = "."
+let dot_dir = dot ^ dir_sep
+let dot_dir_sub = String.sub dot_dir
+let dotdot = ".."
+let dotdot_dir = dotdot ^ dir_sep
+let dotdot_dir_sub = String.sub dotdot_dir
+
+(* Platform specific preliminaties *)
+
+module Windows = struct
+
+  let is_unc_path p = String.is_prefix "\\\\" p
+  let has_drive p = String.exists (Char.equal ':') p
+  let non_unc_path_start p = match String.find (Char.equal ':') p with
+  | None -> 0
+  | Some i -> i + 1 (* exists by construction *)
+
+  let parse_unc s =
+    (* parses an UNC path, the \\ prefix was already parsed, adds a root path
+       if there's only a volume, UNC paths are always absolute. *)
+    let p = String.sub ~start:2 s in
+    let not_bslash c = c <> '\\' in
+    let parse_seg p = String.Sub.span ~min:1 ~sat:not_bslash p in
+    let ensure_root r = Some (if String.Sub.is_empty r then (s ^ "\\") else s)
+    in
+    match parse_seg p with
+    | (seg1, _) when String.Sub.is_empty seg1 -> None (* \\ or \\\ *)
+    | (seg1, rest) ->
+        let seg1_len = String.Sub.length seg1 in
+        match String.Sub.get_head ~rev:true seg1 with
+        | '.' when seg1_len = 1 -> (* \\.\device\ *)
+            begin match parse_seg (String.Sub.tail rest) with
+            | (seg, _) when String.Sub.is_empty seg -> None
+            | (_, rest) -> ensure_root rest
+            end
+        | '?' when seg1_len = 1 ->
+            begin match parse_seg (String.Sub.tail rest) with
+            | (seg2, _) when String.Sub.is_empty seg2 -> None
+            | (seg2, rest) ->
+                if (String.Sub.get_head ~rev:true seg2 = ':') (* \\?\drive:\ *)
+                then (ensure_root rest) else
+                if not (String.Sub.equal_bytes seg2 (String.sub "UNC"))
+                then begin (* \\?\server\share\ *)
+                  match parse_seg (String.Sub.tail rest) with
+                  | (seg, _) when String.Sub.is_empty seg -> None
+                  | (_, rest) -> ensure_root rest
+                end else begin (* \\?\UNC\server\share\ *)
+                  match parse_seg (String.Sub.tail rest) with
+                  | (seg, _) when String.Sub.is_empty seg -> None
+                  | (_, rest) ->
+                      match parse_seg (String.Sub.tail rest) with
+                      | (seg, _) when String.Sub.is_empty seg -> None
+                      | (_, rest) -> ensure_root rest
+                end
+            end
+        | _ -> (* \\server\share\ *)
+            begin match parse_seg (String.Sub.tail rest) with
+            | (seg, _) when String.Sub.is_empty seg -> None
+            | (_, rest) -> ensure_root rest
+            end
+
+  let sub_split_volume p =
+    (* splits a windows path into its volume (or drive) and actual file
+       path. When called the path in [p] is guaranteed to be non empty
+       and if [p] is an UNC path it is guaranteed to the be parseable by
+       parse_unc_windows. *)
+    let split_before i = String.sub p ~stop:i, String.sub p ~start:i in
+    if not (is_unc_path p) then
+      begin match String.find (Char.equal ':') p with
+      | None -> String.Sub.empty, String.sub p
+      | Some i -> split_before (i + 1)
+      end
+    else
+    let bslash ~start = match String.find ~start (Char.equal '\\') p with
+    | None -> assert false | Some i -> i
+    in
+    let i = bslash ~start:2 in
+    let j = bslash ~start:(i + 1) in
+    match p.[i-1] with
+    | '.' when i = 3 -> split_before j
+    | '?' when i = 3 ->
+        if p.[j-1] = ':' then split_before j else
+        if (String.Sub.equal_bytes
+              (String.sub p ~start:(i + 1) ~stop:j)
+              (String.sub "UNC"))
+        then split_before (bslash ~start:((bslash ~start:(j + 1)) + 1))
+      else split_before (bslash ~start:(j + 1))
+    | _ -> split_before j
+
+  let is_root p =
+    let _, path = sub_split_volume p in
+    String.Sub.length path = 1 && String.Sub.get path 0 = dir_sep_char
+end
+
+module Posix = struct
+  let has_volume p = String.is_prefix "//" p
+  let is_root p = String.equal p dir_sep || String.equal p "//"
+end
+
+(* Segments *)
+
+let is_seg_windows s =
+  let valid c = c <> '\x00' && c <> dir_sep_char && c <> '/' in
+  String.for_all valid s
+
+let is_seg_posix s =
+  let valid c = c <> '\x00' && c <> dir_sep_char in
+  String.for_all valid s
+
+let is_seg = if windows then is_seg_windows else is_seg_posix
+
+let _split_last_seg p = String.Sub.span ~rev:true ~sat:not_dir_sep p
+let _sub_last_seg p = String.Sub.take ~rev:true ~sat:not_dir_sep p
+let _sub_last_non_empty_seg p = (* returns empty on roots though *)
+  let dir, last = _split_last_seg p in
+  match String.Sub.is_empty last with
+  | false -> last
+  | true -> _sub_last_seg (String.Sub.tail ~rev:true dir)
+
+let _split_last_non_empty_seg p =
+  let (dir, last_seg as r) = _split_last_seg p in
+  match String.Sub.is_empty last_seg with
+  | false -> r, true
+  | true -> _split_last_seg (String.Sub.tail ~rev:true dir), false
+
+let sub_last_seg_windows p = _sub_last_seg (snd (Windows.sub_split_volume p))
+let sub_last_seg_posix p = _sub_last_seg (String.sub p)
+let sub_last_seg = if windows then sub_last_seg_windows else sub_last_seg_posix
+
+let sub_last_non_empty_seg_windows p =
+  _sub_last_non_empty_seg (snd (Windows.sub_split_volume p))
+
+let sub_last_non_empty_seg_posix p =
+  _sub_last_non_empty_seg (String.sub p)
+
+let sub_last_non_empty_seg =
+  if windows then sub_last_non_empty_seg_windows else
+  sub_last_non_empty_seg_posix
+
+let is_rel_seg = function "." | ".." -> true | _ -> false
+
+let sub_is_rel_seg seg = match String.Sub.length seg with
+| 1 when String.Sub.get seg 0 = '.' -> true
+| 2 when String.Sub.get seg 0 = '.' && String.Sub.get seg 1 = '.' -> true
+| _ -> false
+
+let sub_is_dir_seg seg = match String.Sub.length seg with
+| 0 -> true
+| 1 when String.Sub.get seg 0 = '.' -> true
+| 2 when String.Sub.get seg 0 = '.' && String.Sub.get seg 1 = '.' -> true
+| _ -> false
+
+let segs_of_path p = String.cuts ~sep:dir_sep p
+let segs_to_path segs = String.concat ~sep:dir_sep segs
+
+(* File paths *)
+
+type t = string (* N.B. a path is never "" or something is wrooong. *)
+
+let err s = Error (`Msg (strf "%a: invalid path" String.dump s))
+
+let validate_and_collapse_seps p =
+  (* collapse non-initial sequences of [dir_sep] to a single one and checks
+     no null byte *)
+  let max_idx = String.length p - 1 in
+  let rec with_buf b last_sep k i = (* k is the write index in b *)
+    if i > max_idx then Ok (Bytes.sub_string b 0 k) else
+    let c = string_unsafe_get p i in
+    if c = '\x00' then err p else
+    if c <> dir_sep_char
+    then (bytes_unsafe_set b k c; with_buf b false (k + 1) (i + 1)) else
+    if not last_sep
+    then (bytes_unsafe_set b k c; with_buf b true (k + 1) (i + 1)) else
+    with_buf b true k (i + 1)
+  in
+  let rec try_no_alloc last_sep i =
+    if i > max_idx then Ok p else
+    let c = string_unsafe_get p i in
+    if c = '\x00' then err p else
+    if c <> dir_sep_char then try_no_alloc false (i + 1) else
+    if not last_sep then try_no_alloc true (i + 1) else
+    let b = Bytes.of_string p in (* copy and overwrite starting from i *)
+    with_buf b true i (i + 1)
+  in
+  let start = (* Allow initial double sep for POSIX and UNC paths *)
+    if max_idx > 0 then (if p.[0] = dir_sep_char then 1 else 0) else 0
+  in
+  try_no_alloc false start
+
+let of_string_windows s =
+  if s = "" then err s else
+  let p = String.map (fun c -> if c = '/' then '\\' else c) s in
+  match validate_and_collapse_seps p with
+  | Error _ as e -> e
+  | Ok p as some ->
+      if Windows.is_unc_path p then
+        (match Windows.parse_unc p with None -> err s | Some p -> Ok p)
+      else
+      match String.find (Char.equal ':') p with
+      | None -> some
+      | Some i when i = String.length p - 1 -> err p (* path is empty *)
+      | Some _ -> Ok p
+
+let of_string_posix p = if p = "" then err p else validate_and_collapse_seps p
+let of_string = if windows then of_string_windows else of_string_posix
+
+let v s = match of_string s with
+| Ok p -> p
+| Error (`Msg m) -> invalid_arg m
+
+let add_seg p seg =
+  if not (is_seg seg) then invalid_arg (err_invalid_seg seg);
+  let sep = if p.[String.length p - 1] = dir_sep_char then "" else dir_sep in
+  String.concat ~sep [p; seg]
+
+let append_posix p0 p1 =
+  if p1.[0] = dir_sep_char (* absolute *) then p1 else
+  let sep = if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep in
+  String.concat ~sep [p0; p1]
+
+let append_windows p0 p1 =
+  if Windows.is_unc_path p1 || Windows.has_drive p1 then p1 else
+  if p1.[0] = dir_sep_char then (* absolute *) p1 else
+  let sep = if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep in
+  String.concat ~sep [p0; p1]
+
+let append = if windows then append_windows else append_posix
+
+let ( / ) = add_seg
+let ( // ) = append
+
+let split_volume_windows p =
+  let vol, path = Windows.sub_split_volume p in
+  String.Sub.to_string vol, String.Sub.to_string path
+
+let split_volume_posix p =
+  if Posix.has_volume p then dir_sep, String.with_range ~first:1 p else "", p
+
+let split_volume = if windows then split_volume_windows else split_volume_posix
+
+let segs_windows p =
+  let _, path = Windows.sub_split_volume p in
+  segs_of_path (String.Sub.to_string path)
+
+let segs_posix p =
+  let segs = segs_of_path p in
+  if Posix.has_volume p then List.tl segs else segs
+
+let segs = if windows then segs_windows else segs_posix
+
+(* File and directory paths *)
+
+let is_dir_path p = sub_is_dir_seg (sub_last_seg p)
+let is_file_path p = not (is_dir_path p)
+let to_dir_path p = add_seg p ""
+
+let filename p = match String.Sub.to_string (sub_last_seg p) with
+| "" | "." | ".." -> ""
+| filename -> filename
+
+(* Base and parent paths *)
+
+let sub_is_root p = String.Sub.length p = 1 && String.Sub.get p 0 = dir_sep_char
+
+let _split_base p =
+  let dir, last_seg = _split_last_seg p in
+  match String.Sub.is_empty dir with
+  | true -> (* single seg *) dot_dir_sub, String.Sub.to_string p
+  | false ->
+      match String.Sub.is_empty last_seg with
+      | false -> dir, String.Sub.to_string last_seg
+      | true ->
+          let dir_file = String.Sub.tail ~rev:true dir in
+          let dir, dir_last_seg = _split_last_seg dir_file in
+          match String.Sub.is_empty dir with
+          | true -> dot_dir_sub, String.Sub.to_string p
+          | false -> dir, String.Sub.(to_string (extend dir_last_seg))
+
+let split_base_windows p =
+  let vol, path = Windows.sub_split_volume p in
+  if sub_is_root path then p, dot_dir else
+  let dir, b = _split_base path in
+  String.Sub.(base_string (append vol dir)), b
+
+let split_base_posix p =
+  if Posix.is_root p then p, dot_dir else
+  let dir, b = _split_base (String.sub p) in
+  String.Sub.to_string dir, b
+
+let split_base = if windows then split_base_windows else split_base_posix
+
+let base p = snd (split_base p)
+
+let _basename p = match String.Sub.to_string (_sub_last_non_empty_seg p) with
+| "." | ".." -> ""
+| basename -> basename
+
+let basename_windows p =
+  let vol, path = Windows.sub_split_volume p in
+  if sub_is_root path then "" else _basename path
+
+let basename_posix p = if Posix.is_root p then "" else _basename (String.sub p)
+let basename p = if windows then basename_windows p else basename_posix p
+
+let _parent p =
+  (* The parent algorithm is not very smart. It tries to preserve the
+     original path and avoids dealing with normalization. We simply
+     only keep everything before the last non-empty, non-relative,
+     path segment and if the resulting path is empty we return
+     "./". Otherwise if the last non-empty segment is "." or ".." we
+     simply postfix with "../" *)
+  let (dir, seg), is_last = _split_last_non_empty_seg p in
+  let dsep = if is_last then dir_sep_sub else String.Sub.empty in
+  if sub_is_rel_seg seg then [p; dsep; dotdot_dir_sub] else
+  if String.Sub.is_empty dir then [dot_dir_sub] else [dir]
+
+let parent_windows p =
+  let vol, path = Windows.sub_split_volume p in
+  if sub_is_root path then p else
+  String.Sub.(base_string @@ concat (vol :: _parent path))
+
+let parent_posix p =
+  if Posix.is_root p then p else
+  String.Sub.(base_string @@ concat (_parent (String.sub p)))
+
+let parent = if windows then parent_windows else parent_posix
+
+(* Normalization *)
+
+let rem_empty_seg_windows p =
+  let vol, path = Windows.sub_split_volume p in
+  if sub_is_root path then p else
+  let max = String.Sub.stop_pos path - 1 in
+  if String.get p max <> dir_sep_char then p else
+  String.with_index_range p ~last:(max - 1)
+
+let rem_empty_seg_posix p = match String.length p with
+| 1 -> p
+| 2 ->
+    if p.[0] <> dir_sep_char && p.[1] = dir_sep_char
+    then String.of_char p.[0]
+    else p
+| len ->
+    let max = len - 1 in
+    if p.[max] <> dir_sep_char then p else
+    String.with_index_range p ~last:(max - 1)
+
+let rem_empty_seg =
+  if windows then rem_empty_seg_windows else rem_empty_seg_posix
+
+let normalize_rel_segs segs = (* result is non empty but may be [""] *)
+  let rec loop acc = function
+  | "." :: [] -> ("" :: acc) (* final "." remove but preserve directoryness. *)
+  | "." :: rest -> loop acc rest
+  | ".." :: rest ->
+      begin match acc with
+      | ".." :: _ | [] -> loop (".." :: acc) rest
+      | seg :: acc -> (* N.B. seg can't be "." *)
+          match rest with
+          | [] -> ("" :: acc) (* preserve directoryness *)
+          | rest -> loop acc rest
+      end
+  | seg :: rest -> loop (seg :: acc) rest
+  | [] ->
+      match acc with
+      | ".." :: _ -> ("" :: acc) (* normalize final .. to ../ *)
+      |  [] -> [""]
+      | acc -> acc
+  in
+  List.rev (loop [] segs)
+
+let normalize_segs = function
+| "" :: segs -> (* absolute path *)
+    let rec rem_dotdots = function ".." :: ss -> rem_dotdots ss | ss -> ss in
+    "" :: (rem_dotdots @@ normalize_rel_segs segs)
+| segs ->
+    match normalize_rel_segs segs with
+    | [""] -> ["."; ""]
+    | segs -> segs
+
+let normalize_windows p =
+  let vol, path = Windows.sub_split_volume p in
+  let path = String.Sub.to_string path in
+  let path = segs_to_path @@ normalize_segs (segs_of_path path) in
+  String.Sub.(to_string (concat [vol; String.sub path]))
+
+let normalize_posix p =
+  let has_volume = Posix.has_volume p in
+  let segs = segs_of_path p in
+  let segs = normalize_segs @@ if has_volume then List.tl segs else segs in
+  let segs = if has_volume then "" :: segs else segs in
+  segs_to_path segs
+
+let normalize = if windows then normalize_windows else normalize_posix
+
+(* Prefixes *)
+
+let is_prefix prefix p =
+  if not (String.is_prefix prefix p) then false else
+  (* Further check the prefix is segment-based. If [prefix] ends with a
+     dir_sep_char nothing more needs to be checked. If it doesn't we need
+     to check that [p]'s remaining suffix is either empty or
+     starts with a directory separator. *)
+  let suff_start = String.length prefix in
+  if prefix.[suff_start - 1] = dir_sep_char then true else
+  if suff_start = String.length p then (* suffix empty *) true else
+  p.[suff_start] = dir_sep_char
+
+let _prefix_last_index p0 p1 = (* last char index of segment-based prefix *)
+  let l0 = String.length p0 in
+  let l1 = String.length p1 in
+  let p0, p1, max = if l0 < l1 then p0, p1, l0 - 1 else p1, p0, l1 - 1 in
+  let rec loop last_dir_sep i p0 p1 = match i > max || p0.[i] <> p1.[i] with
+  | false ->
+      let last_dir_sep = if p0.[i] = dir_sep_char then i else last_dir_sep in
+      loop last_dir_sep (i + 1) p0 p1
+  | true ->
+      if i = 0 then None else
+      let last = i - 1 in
+      if last_dir_sep = last then Some last else
+      match last = max with
+      | true ->
+          if l1 = l0 then Some last else
+          if p1.[i] = dir_sep_char then Some last else
+          if last_dir_sep <> -1 then Some last_dir_sep else None
+      | false ->
+          if last_dir_sep <> -1 then Some last_dir_sep else None
+  in
+  loop (-1) 0 p0 p1
+
+let find_prefix_windows p0 p1 = match _prefix_last_index p0 p1 with
+| None -> None
+| Some i ->
+    let v0_len = String.Sub.length (fst (Windows.sub_split_volume p0)) in
+    let v1_len = String.Sub.length (fst (Windows.sub_split_volume p1)) in
+    let max_vlen = if v0_len > v1_len then v0_len else v1_len in
+    if i < max_vlen then None else Some (String.with_index_range p0 ~last:i)
+
+let find_prefix_posix p0 p1 = match _prefix_last_index p0 p1 with
+| None -> None
+| Some 0 when Posix.has_volume p0 || Posix.has_volume p1 -> None
+| Some i -> Some (String.with_index_range p0 ~last:i)
+
+let find_prefix = if windows then find_prefix_windows else find_prefix_posix
+
+let rem_prefix prefix p = match is_prefix prefix p with
+| false -> None
+| true ->
+    match String.length prefix with
+    | len when len = String.length p -> None
+    | len ->
+        let first = if p.[len] = dir_sep_char then len + 1 else len in
+        match String.with_index_range p ~first with
+        | "" -> Some dot_dir
+        | q -> Some q
+
+(* Roots and relativization *)
+
+let _relativize ~root p =
+  let root = (* root is always interpreted as a directory *)
+    let root = normalize root in
+    if root.[String.length root - 1] = dir_sep_char then root else
+    root ^ dir_sep
+  in
+  let p = normalize p in
+  let rec walk root p = match root, p with
+  | (".." :: _, s :: _) when s <> ".." ->
+      (* [root] has too many up segments. Cannot walk down to express [p],
+           e.g. "../a" can't be expressed relative to "../../". *)
+      None
+  | (sr :: root, sp :: (_ :: _ as p)) when sr = sp ->
+      (* the next directory in [root] and [p] match and it's not the last
+         segment of [p], walk to next segment *)
+      walk root p
+  | [""], [""] ->
+      (* walk ends at the end of both path simultaneously, [p] is a
+         directory that matches exactly [root] interpreted as a directory. *)
+      Some (segs_to_path ["."; ""])
+  | root, p ->
+      (* walk ends here, either the next directory is different in
+         [root] and [p] or it is equal but it is the last one for [p]
+         and different from [""] (i.e. [p] is a file path and prefix
+         of [root]). To get to the current position from the remaining
+         root we need to go up the number of non-empty segments that
+         remain in [root] (length root - 1). To get to the path [p]
+         from the current position we just use [p] so prepending
+         length root - 1 ".." segments to [p] tells us how to go from
+         the remaining root to [p]. *)
+      let segs = List.fold_left (fun acc _ -> dotdot :: acc) p (List.tl root) in
+      Some (segs_to_path segs)
+  in
+  match segs root, segs p with
+  | ("" :: _, s :: _) when s <> "" -> None (* absolute/relative mismatch *)
+  | (s :: _, "" :: _) when s <> "" -> None (* absolute/relative mismatch *)
+  | ["."; ""], p ->
+      (* p is relative and must be expressed w.r.t. "./", so it is itself. *)
+      Some (segs_to_path p)
+  | root, p ->
+      (* walk in the segments of root and p until a segment mismatches.
+         at that point express the remaining p relative to the remaining
+         root. Note that because of normalization both [root] and [p] may
+         only have initial .. segments and [root] by construction has a
+         final "" segment. *)
+      walk root p
+
+let relativize_windows ~root p =
+  let rvol, root = Windows.sub_split_volume root in
+  let pvol, p = Windows.sub_split_volume p in
+  if not (String.Sub.equal_bytes rvol pvol) then None else
+  let root = String.Sub.to_string root in
+  let p = String.Sub.to_string p in
+  _relativize ~root p
+
+let relativize_posix ~root p = _relativize ~root p
+
+let relativize = if windows then relativize_windows else relativize_posix
+
+let is_rooted ~root p = match relativize ~root p with
+| None -> false
+| Some r -> not (String.equal dotdot r || String.is_prefix dotdot_dir r)
+
+(* Predicates and comparison *)
+
+let is_rel_posix p = p.[0] <> dir_sep_char
+let is_rel_windows p =
+  if Windows.is_unc_path p then false else
+  p.[Windows.non_unc_path_start p] <> dir_sep_char
+
+let is_rel = if windows then is_rel_windows else is_rel_posix
+let is_abs p = not (is_rel p)
+let is_root = if windows then Windows.is_root else Posix.is_root
+
+let is_current_dir_posix ?(prefix = false) p = match prefix with
+| false ->  String.equal dot p || String.equal dot_dir p
+| true -> String.equal dot p || String.is_prefix dot_dir p
+
+let is_current_dir_windows ?(prefix = false) p =
+  if Windows.is_unc_path p then false else
+  let start = Windows.non_unc_path_start p in
+  match String.length p - start with
+  | 1 -> p.[start] = '.'
+  | n when n = 2 || prefix -> p.[start] = '.' && p.[start + 1] = dir_sep_char
+  | _ -> false
+
+let is_current_dir =
+  if windows then is_current_dir_windows else is_current_dir_posix
+
+let is_parent_dir_posix ?(prefix = false) p = match prefix with
+| false -> String.equal dotdot p || String.equal dotdot_dir p
+| true -> String.equal dotdot p || String.is_prefix dotdot_dir p
+
+let is_parent_dir_windows ?(prefix = false) p =
+  if Windows.is_unc_path p then false else
+  let start = Windows.non_unc_path_start p in
+  match String.length p - start with
+  | 1 -> false
+  | 2 -> p.[start] = '.' && p.[start + 1] = '.'
+  | n when n = 3 || prefix ->
+      p.[start] = '.' && p.[start + 1] = '.' && p.[start + 2] = dir_sep_char
+  | _ -> false
+
+let is_parent_dir =
+  if windows then is_parent_dir_windows else is_parent_dir_posix
+
+let is_dotfile p = match basename p with | "" -> false | s -> s.[0] = '.'
+
+let equal = String.equal
+let compare = String.compare
+
+(* Conversions and pretty printing *)
+
+let to_string p = p
+let pp ppf p = Format.pp_print_string ppf (to_string p)
+let dump ppf p = String.dump ppf (to_string p)
+
+(* File extensions *)
+
+type ext = string
+
+let ext_sep_char = '.'
+let ext_sep = String.of_char ext_sep_char
+let ext_sep_sub = String.Sub.of_char ext_sep_char
+let eq_ext_sep c = c = ext_sep_char
+let neq_ext_sep c = c <> ext_sep_char
+
+let rec sub_multi_ext seg =
+  let first_not_sep = String.Sub.drop ~sat:eq_ext_sep seg in
+  String.Sub.drop ~sat:neq_ext_sep first_not_sep
+
+let sub_single_ext seg =
+  let name_dot, ext = String.Sub.span ~rev:true ~sat:neq_ext_sep seg in
+  if String.Sub.exists neq_ext_sep name_dot
+  then String.Sub.extend ~max:1 ~rev:true ext
+  else String.Sub.empty
+
+let sub_ext ?(multi = false) seg =
+  if multi then sub_multi_ext seg else sub_single_ext seg
+
+let sub_get_ext ?multi p = sub_ext ?multi (sub_last_non_empty_seg p)
+let get_ext ?multi p = String.Sub.to_string (sub_get_ext ?multi p)
+
+let has_ext e p =
+  let ext = sub_get_ext ~multi:true p in
+  if String.Sub.is_empty ext then false else
+  if not (String.(Sub.is_suffix (sub e) ext)) then false else
+  if not (String.is_empty e) && e.[0] = ext_sep_char then true else
+  (* Check there's a dot before the suffix [e] in [ext] *)
+  let dot_index = String.Sub.length ext - String.length e - 1 in
+  String.Sub.get ext dot_index = ext_sep_char
+
+let mem_ext exts p = List.exists (fun ext -> has_ext ext p) exts
+
+let exists_ext ?(multi = false) p =
+  let ext = sub_get_ext ~multi p in
+  if multi then String.Sub.exists eq_ext_sep (String.Sub.tail ext) else
+  not (String.Sub.is_empty ext)
+
+let add_ext e p =
+  if String.is_empty e then p else
+  if not (is_seg e) then invalid_arg (err_invalid_ext e) else
+  let seg = sub_last_non_empty_seg p in
+  if sub_is_dir_seg seg then p else
+  let e_has_dot = e.[0] = ext_sep_char in
+  let maybe_dot = if e_has_dot then String.Sub.empty else ext_sep_sub in
+  let has_empty = p.[String.length p - 1] = dir_sep_char in
+  let maybe_empty = if has_empty then dir_sep_sub else String.Sub.empty in
+  let seg_end = String.Sub.stop_pos seg - 1 in
+  let prefix = String.sub_with_index_range ~last:seg_end p in
+  let path = [prefix; maybe_dot; String.sub e; maybe_empty] in
+  String.Sub.(base_string (concat path))
+
+let _split_ext ?multi p =
+  let ext = sub_get_ext ?multi p in
+  if String.Sub.is_empty ext then p, ext else
+  let before_ext = String.Sub.start_pos ext - 1 in
+  if String.Sub.stop_pos ext = String.length p
+  then String.with_index_range p ~last:before_ext, ext else
+  let prefix = String.sub_with_index_range p ~last:before_ext in
+  String.Sub.(base_string (concat [prefix; dir_sep_sub])), ext
+
+let rem_ext ?multi p = fst (_split_ext ?multi p)
+let set_ext ?multi e p = add_ext e (rem_ext ?multi p)
+let split_ext ?multi p =
+  let p, ext = _split_ext ?multi p in
+  p, String.Sub.to_string ext
+
+let ( + ) p e = add_ext e p
+let ( -+ ) p e = set_ext e p
+
+(* Path sets and maps *)
+
+type path = t
+
+module Set = struct
+  include Set.Make (String)
+
+  let pp ?sep:(pp_sep = Format.pp_print_cut) pp_elt ppf ps =
+    let pp_elt elt is_first =
+      if is_first then () else pp_sep ppf ();
+      Format.fprintf ppf "%a" pp_elt elt; false
+    in
+    ignore (fold pp_elt ps true)
+
+  let dump_path = dump
+  let dump ppf ss =
+    let pp_elt elt is_first =
+      if is_first then () else Format.fprintf ppf "@ ";
+      Format.fprintf ppf "%a" dump_path elt;
+      false
+    in
+    Format.fprintf ppf "@[<1>{";
+    ignore (fold pp_elt ss true);
+    Format.fprintf ppf "}@]";
+    ()
+
+  let err_empty () = invalid_arg "empty set"
+  let err_absent p ps =
+    invalid_arg (strf "%a not in set %a" dump_path p dump ps)
+
+  let get_min_elt ps = try min_elt ps with Not_found -> err_empty ()
+  let min_elt ps = try Some (min_elt ps) with Not_found -> None
+
+  let get_max_elt ps = try max_elt ps with Not_found -> err_empty ()
+  let max_elt ps = try Some (max_elt ps) with Not_found -> None
+
+  let get_any_elt ps = try choose ps with Not_found -> err_empty ()
+  let choose ps = try Some (choose ps) with Not_found -> None
+
+  let get p ps = try find p ps with Not_found -> err_absent p ps
+  let find p ps = try Some (find p ps) with Not_found -> None
+
+  let of_list = List.fold_left (fun acc s -> add s acc) empty
+end
+
+module Map = struct
+  include Map.Make (String)
+
+  let err_empty () = invalid_arg "empty map"
+  let err_absent s = invalid_arg (strf "%s is not bound in map" s)
+
+  let get_min_binding m = try min_binding m with Not_found -> err_empty ()
+  let min_binding m = try Some (min_binding m) with Not_found -> None
+
+  let get_max_binding m = try max_binding m with Not_found -> err_empty ()
+  let max_binding m = try Some (max_binding m) with Not_found -> None
+
+  let get_any_binding m = try choose m with Not_found -> err_empty ()
+  let choose m = try Some (choose m) with Not_found -> None
+
+  let get k s = try find k s with Not_found -> err_absent k
+  let find k m = try Some (find k m) with Not_found -> None
+
+  let dom m = fold (fun k _ acc -> Set.add k acc) m Set.empty
+
+  let of_list bs = List.fold_left (fun m (k,v) -> add k v m) empty bs
+
+  let pp ?sep:(pp_sep = Format.pp_print_cut) pp_binding ppf (m : 'a t) =
+    let pp_binding k v is_first =
+      if is_first then () else pp_sep ppf ();
+      pp_binding ppf (k, v); false
+    in
+    ignore (fold pp_binding m true)
+
+  let dump pp_v ppf m =
+    let pp_binding k v is_first =
+      if is_first then () else Format.fprintf ppf "@ ";
+      Format.fprintf ppf "@[<1>(@[%a@],@ @[%a@])@]" dump k pp_v v;
+      false
+    in
+    Format.fprintf ppf "@[<1>{";
+    ignore (fold pp_binding m true);
+    Format.fprintf ppf "}@]";
+    ()
+end
+
+type set = Set.t
+type 'a map = 'a Map.t
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/fpath/src/fpath.mllib

@@ -0,0 +1 @@
+Fpath

unikernel/duniverse/fpath/src/fpath_top.ml

@@ -0,0 +1,23 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+   %%NAME%% %%VERSION%%
+  ---------------------------------------------------------------------------*)
+
+let () = ignore (Toploop.use_file Format.err_formatter "fpath_top_init.ml")
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/fpath/src/fpath_top.mllib

@@ -0,0 +1 @@
+Fpath_top

unikernel/duniverse/fpath/src/fpath_top_init.ml

@@ -0,0 +1,23 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+   %%NAME%% %%VERSION%%
+  ---------------------------------------------------------------------------*)
+
+#install_printer Fpath.pp;;
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/fpath/test/test.ml

@@ -0,0 +1,28 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+   %%NAME%% %%VERSION%%
+  ---------------------------------------------------------------------------*)
+
+let tests () = Testing.run
+    [ Test_fpath.suite; ]
+
+let run () = tests (); Testing.log_results ()
+
+let () = if run () then exit 0 else exit 1
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/fpath/test/testing.ml

@@ -0,0 +1,258 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+   %%NAME%% %%VERSION%%
+  ---------------------------------------------------------------------------*)
+
+(* Value equality and pretty printing *)
+
+type 'a eq = 'a -> 'a -> bool
+type 'a pp = Format.formatter -> 'a -> unit
+
+(* Pretty printers *)
+
+let pp = Format.fprintf
+let pp_exn ppf v = pp ppf "%s" (Printexc.to_string v)
+let pp_bool ppf v = pp ppf "%b" v
+let pp_char ppf v = pp ppf "%C" v
+let pp_str ppf v = pp ppf "%S" v
+let pp_int = Format.pp_print_int
+let pp_float ppf v = pp ppf "%.10f" (* bof... *) v
+let pp_int32 ppf v = pp ppf "%ld" v
+let pp_int64 ppf v = pp ppf "%Ld" v
+let pp_text = Format.pp_print_text
+let pp_list pp_v ppf l =
+  let pp_sep ppf () = pp ppf ";@," in
+  pp ppf "@[<1>[%a]@]" (Format.pp_print_list ~pp_sep pp_v) l
+
+let pp_option pp_v ppf = function
+| None -> Format.fprintf ppf "None"
+| Some v -> Format.fprintf ppf "Some %a" pp_v v
+
+let pp_slot_loc ppf l =
+  pp ppf "%s:%d.%d-%d:"
+    l.Printexc.filename l.Printexc.line_number
+    l.Printexc.start_char l.Printexc.end_char
+
+let pp_bt ppf bt = match Printexc.backtrace_slots bt with
+| None -> pp ppf "@,@[%a@]" pp_text "No backtrace. Did you compile with -g ?"
+| Some slots ->
+    let rec loop = function
+    | [] -> assert false
+    | s :: ss ->
+        begin match Printexc.Slot.location s with
+        | None -> ()
+        | Some l when l.Printexc.filename = "test/testing.ml" ||
+                      l.Printexc.filename = "test/test.ml" -> ()
+        | Some l -> pp ppf "@,%a" pp_slot_loc l
+        end;
+        if ss <> [] then (loop ss) else ()
+    in
+    loop (Array.to_list slots)
+
+(* Assertion counters *)
+
+let fail_count = ref 0
+let pass_count = ref 0
+
+(* Logging *)
+
+let log_part fmt = Format.printf fmt
+let log ?header fmt = match header with
+| Some h -> Format.printf ("[%s] " ^^ fmt ^^ "@.") h
+| None -> Format.printf (fmt ^^ "@.")
+
+let log_results () =
+  let total = !pass_count + !fail_count in
+  match !fail_count with
+  | 0 -> log ~header:"OK" "All %d assertions succeeded !@." total; true
+  | 1 -> log ~header:"FAIL" "1 failure out of %d assertions" total; false
+  | n -> log ~header:"FAIL" "%d failures out of %d assertions"
+           !fail_count total; false
+
+let log_fail msg bt =
+  log ~header:"FAIL" "@[<v>@[%a@]%a@]" pp_text msg pp_bt bt
+
+let log_unexpected_exn ~header exn bt =
+  log ~header:"SUITE" "@[<v>@[ABORTED: unexpected exception:@]@,%a%a@]"
+    pp_exn exn pp_bt bt
+
+(* Testing scopes *)
+
+exception Fail
+exception Fail_handled
+
+let block f = try f () with
+| Fail | Fail_handled -> ()
+| exn ->
+    let bt = Printexc.get_raw_backtrace () in
+    incr fail_count;
+    log_unexpected_exn ~header:"BLOCK" exn bt
+
+type test = string * (unit -> unit)
+
+let test n f = n, f
+let run_test (n, f) =
+  log "* %s" n;
+  try f () with
+  | Fail | Fail_handled ->
+      log ~header:"TEST" "ABORTED: a test failure blew the test scope"
+  | exn ->
+      let bt = Printexc.get_raw_backtrace () in
+      incr fail_count;
+      log_unexpected_exn ~header:"TEST" exn bt
+
+type suite = string * test list
+let suite n ts = n, ts
+let run_suite (n, ts) = try log "%s" n; List.iter run_test ts with
+| exn ->
+    let bt = Printexc.get_raw_backtrace () in
+    incr fail_count;
+    log_unexpected_exn ~header:"SUITE" exn bt
+
+let run suites = List.iter run_suite suites
+
+(* Passing and failing tests *)
+
+let pass () = incr pass_count
+let fail fmt =
+  let bt = Printexc.get_callstack 10 in
+  let fail _ = log_fail (Format.flush_str_formatter ()) bt in
+  (incr fail_count; Format.kfprintf fail Format.str_formatter fmt)
+
+(* Checking values *)
+
+let pp_neq pp_v ppf (v, v') = pp ppf "@[%a@]@ <>@ @[%a@]@]" pp_v v pp_v v'
+
+let fail_eq pp v v' = fail "%a" (pp_neq pp) (v, v')
+
+let eq ~eq ~pp v v' = if eq v v' then pass () else fail_eq pp v v'
+let eq_char = eq ~eq:(=) ~pp:pp_char
+let eq_str = eq ~eq:(=) ~pp:pp_str
+let eq_bool = eq ~eq:(=) ~pp:Format.pp_print_bool
+let eq_int = eq ~eq:(=) ~pp:Format.pp_print_int
+let eq_int32 = eq ~eq:(=) ~pp:pp_int32
+let eq_int64 = eq ~eq:(=) ~pp:pp_int64
+let eq_float = eq ~eq:(=) ~pp:pp_float
+let eq_nan f =
+  if f <> f then pass () else fail "@[%a@]@ is@ not a NaN" pp_float f
+
+let eq_option ~eq:eq_v ~pp =
+  let eq_opt v v' = match v, v' with
+  | Some v, Some v' -> eq_v v v'
+  | None, None -> true
+  | _ -> false
+  in
+  let pp = pp_option pp in
+  fun v v' -> eq ~eq:eq_opt ~pp v v'
+
+let eq_some = function
+| Some _ -> pass ()
+| None -> fail "None <> Some _"
+
+let eq_none ~pp = function
+| None -> pass ()
+| Some v -> fail "@[%a <>@ None@]" pp v
+
+let eq_list ~eq:eq_v ~pp:pp_v =
+  let eql l l' = try List.for_all2 eq_v l l' with Invalid_argument _ -> false in
+  fun l l' -> eq ~eq:eql ~pp:(pp_list pp_v) l l'
+
+(* Tracing and checking function applications. *)
+
+type app = (* Gathers information about the application *)
+  { fail_count : int; (* fail_count checkpoint when the app starts *)
+    pp_args : Format.formatter -> unit -> unit; }
+
+let ctx () = { fail_count = -1; pp_args = fun ppf () -> (); }
+
+let log_app_raised app exn =
+  log "@[<2>@[%a@]==> raised %a" app.pp_args () pp_exn exn
+
+let pp_app app pp_v ppf v =
+  pp ppf "@[<2>@[%a@]==>@ @[%a@]@]" app.pp_args () pp_v v
+
+let log_app app pp_v v = log "%a" (pp_app app pp_v) v
+
+let ( $ ) f k = k (ctx ()) f
+
+let ( @-> ) (pp_v : 'a pp) k app f v =
+  let pp_args ppf () = app.pp_args ppf (); pp ppf "%a@ " pp_v v in
+  let fc = if app.fail_count = -1 then !fail_count else app.fail_count in
+  let app = { fail_count = fc; pp_args } in
+  try k app (f v) with
+  | Fail ->
+      log_app app pp_v v;
+      raise Fail_handled
+  | Fail_handled as e -> raise e
+  | exn ->
+      log_app_raised app exn;
+      fail "unexpected exception %a raised" pp_exn exn;
+      raise Fail_handled
+
+let ret pp app v =
+  if !fail_count <> app.fail_count then log_app app pp v;
+  v
+
+let ret_eq ~eq pp r app v =
+  if eq r v then (pass (); ret pp app v) else
+  (fail "@[<v>%a@,%a@]" (pp_neq pp) (r, v) (pp_app app pp) v;
+   raise Fail_handled)
+
+let ret_none pp app v = match v with
+| None -> pass (); ret (pp_option pp) app v
+| Some _ -> ret_eq ~eq:(=) (pp_option pp) None app v
+
+let ret_some pp app v = match v with
+| Some _ as v -> pass (); ret (pp_option pp) app v
+| None as v ->
+    fail "@[<v>Some _ <> None@,%a@]" (pp_app app (pp_option pp)) v;
+    raise Fail_handled
+
+let ret_get_option pp app v = match ret_some pp app v with
+| Some v -> v
+| None -> assert false
+
+(* I think we could handle the following functions on app traced ones
+   by enriching the app type and have alternate functions to $ for
+   handling these cases. Note that the only place were we can check
+   for these things are in the @-> combinator *)
+
+let app_invalid ~pp f v =
+  try
+    let r = f v in
+    fail "%a <> exception Invalid_arg _" pp r
+  with
+  | Invalid_argument _ -> pass ()
+  | exn -> fail "exception %a <> exception Invalid_arg _" pp_exn exn
+
+let app_exn ~pp e f v =
+  try
+    let r = f v in
+    fail "%a <> exception %a" pp r pp_exn e
+  with
+  | exn when exn = e -> pass ()
+  | exn -> fail "exception %a <> exception %a_" pp_exn exn pp_exn e
+
+let app_raises ~pp f v =
+  try
+    let r = f v in
+    fail "%a <> exception _ " pp r
+  with
+  | exn -> pass ()
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/fpath/test/testing.mli

@@ -0,0 +1,93 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+   %%NAME%% %%VERSION%%
+  ---------------------------------------------------------------------------*)
+
+(* {1 Value equality and pretty printing} *)
+
+type 'a eq = 'a -> 'a -> bool
+type 'a pp = Format.formatter -> 'a -> unit
+
+(* {1 Pretty printers} *)
+
+val pp_int : int pp
+val pp_bool : bool pp
+val pp_float : float pp
+val pp_char : char pp
+val pp_str : string pp
+val pp_list : 'a pp -> 'a list pp
+val pp_option : 'a pp -> 'a option pp
+
+(* {1 Logging} *)
+
+val log_part : ('a, Format.formatter, unit) format -> 'a
+val log : ?header:string -> ('a, Format.formatter, unit) format -> 'a
+val log_results : unit -> bool
+
+(* {1 Testing scopes} *)
+
+type test
+type suite
+
+val block : (unit -> unit) -> unit
+val test : string -> (unit -> unit) -> test
+val suite : string -> test list -> suite
+
+val run : suite list -> unit
+
+(* {1 Passing and failing tests} *)
+
+val pass : unit -> unit
+val fail : ('a, Format.formatter, unit, unit) format4 -> 'a
+
+(* {1 Checking values} *)
+
+val eq : eq:'a eq -> pp:'a pp -> 'a -> 'a -> unit
+val eq_char : char -> char -> unit
+val eq_str : string -> string -> unit
+val eq_bool : bool -> bool -> unit
+val eq_int : int -> int -> unit
+val eq_int32 : int32 -> int32 -> unit
+val eq_int64 : int64 -> int64 -> unit
+val eq_float : float -> float -> unit
+val eq_nan : float -> unit
+
+val eq_option : eq:'a eq -> pp:'a pp -> 'a option -> 'a option -> unit
+val eq_some : 'a option -> unit
+val eq_none : pp:'a pp -> 'a option -> unit
+
+val eq_list : eq:'a eq -> pp:'a pp -> 'a list -> 'a list -> unit
+
+(* {1 Tracing and checking function applications} *)
+
+type app (* holds information about the application *)
+
+val ( $ ) : 'a -> (app -> 'a -> 'b) -> 'b
+val ( @-> ) : 'a pp -> (app -> 'b -> 'c) -> app -> ('a -> 'b) -> 'a -> 'c
+
+val ret : 'a pp -> app -> 'a -> 'a
+val ret_eq : eq:'a eq -> 'a pp -> 'a -> app -> 'a -> 'a
+val ret_some : 'a pp -> app -> 'a option -> 'a option
+val ret_none : 'a pp -> app -> 'a option -> 'a option
+val ret_get_option : 'a pp -> app -> 'a option -> 'a
+
+val app_invalid : pp:'b pp -> ('a -> 'b) -> 'a -> unit
+val app_exn : pp:'b pp -> exn -> ('a -> 'b) -> 'a -> unit
+val app_raises : pp:'b pp -> ('a -> 'b) -> 'a -> unit
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The fpath programmers
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)