Signed-off-by: Tomáš Golembiovský <tgolembi(a)redhat.com>
---
mllib/common_utils.ml | 9 +++++++++
mllib/common_utils.mli | 10 ++++++++++
mllib/common_utils_tests.ml | 7 +++++++
3 files changed, 26 insertions(+)
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index e9ae6a4a2..a79abdd7e 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -236,6 +236,15 @@ end
let (//) = Filename.concat
let quote = Filename.quote
+let subdirectory parent path =
+ if path = parent then
+ ""
+ else if String.is_prefix path (parent // "") then
+ let len = String.length parent in
+ String.sub path (len+1) (String.length path - len-1)
+ else
+ raise (Invalid_argument (sprintf "%S is not a path prefix of %S" parent
path))
+
let ( +^ ) = Int64.add
let ( -^ ) = Int64.sub
let ( *^ ) = Int64.mul
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 722e528e5..977ce6576 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -116,6 +116,16 @@ val ( // ) : string -> string -> string
val quote : string -> string
(** Shell-safe quoting of a string (alias for {!Filename.quote}). *)
+val subdirectory : string -> string -> string
+(** [subdirectory parent path] returns subdirectory part of [path] relative
+ to the [parent]. If [path] and [parent] point to the same directory empty
+ string is returned.
+
+ Note: path normalization on arguments is NOT performed!
+
+ If [parent] is not a path prefix of [path] the function raises
+ [Invalid_argument]. *)
+
val ( +^ ) : int64 -> int64 -> int64
val ( -^ ) : int64 -> int64 -> int64
val ( *^ ) : int64 -> int64 -> int64
diff --git a/mllib/common_utils_tests.ml b/mllib/common_utils_tests.ml
index 77b0524c1..aacc01e04 100644
--- a/mllib/common_utils_tests.ml
+++ b/mllib/common_utils_tests.ml
@@ -27,6 +27,12 @@ let assert_equal_int = assert_equal ~printer:(fun x -> string_of_int
x)
let assert_equal_int64 = assert_equal ~printer:(fun x -> Int64.to_string x)
let assert_equal_stringlist = assert_equal ~printer:(fun x -> "(" ^
(String.escaped (String.concat "," x)) ^ ")")
+let test_subdirectory ctx =
+ assert_equal_string "" (subdirectory "/foo" "/foo");
+ assert_equal_string "" (subdirectory "/foo" "/foo/");
+ assert_equal_string "bar" (subdirectory "/foo"
"/foo/bar");
+ assert_equal_string "bar/baz" (subdirectory "/foo"
"/foo/bar/baz")
+
(* Test Common_utils.int_of_le32 and Common_utils.le32_of_int. *)
let test_le32 ctx =
assert_equal_int64 0x20406080L (int_of_le32 "\x80\x60\x40\x20");
@@ -129,6 +135,7 @@ let test_string_lines_split ctx =
let suite =
"mllib Common_utils" >:::
[
+ "subdirectory" >:: test_subdirectory;
"numeric.le32" >:: test_le32;
"sizes.parse_resize" >:: test_parse_resize;
"sizes.human_size" >:: test_human_size;
--
2.11.0