From d87bf006438909c6057af7b4d3380124a6ab5edf Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Tue, 22 Oct 2024 13:39:04 +0200 Subject: [PATCH] Raise [Vcs.E] more systematically --- CHANGES.md | 4 +- lib/vcs/src/graph.ml | 8 +- lib/vcs/src/vcs_exn.ml | 4 - lib/vcs/src/vcs_exn.mli | 4 - lib/vcs/test/test__graph.ml | 16 ++-- lib/vcs_command/src/vcs_command.ml | 27 +++--- lib/vcs_git_provider/src/log.ml | 31 +++++-- lib/vcs_git_provider/src/munged_path.ml | 46 +++++----- lib/vcs_git_provider/src/name_status.ml | 62 +++++++------ lib/vcs_git_provider/src/num_status.ml | 46 ++++++---- lib/vcs_git_provider/src/refs.ml | 72 +++++++++++----- lib/vcs_git_provider/src/refs.mli | 3 +- lib/vcs_git_provider/test/test__log.ml | 16 +++- .../test/test__munged_path.ml | 23 +++-- .../test/test__name_status.ml | 86 ++++++++++++++++--- lib/vcs_git_provider/test/test__num_status.ml | 73 ++++++++++++---- lib/vcs_git_provider/test/test__refs.ml | 35 ++++++-- 17 files changed, 381 insertions(+), 175 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index ffe0cd8..86ca81b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -9,7 +9,6 @@ ### Changed - Provider interfaces now uses `Vcs.Result` type instead of `Or_error` (#34, @mbarbin). -- Moved `Vcs.raise_s` to `Vcs.Exn.raise_s` to group exn related helpers (#34, @mbarbin). - Rename what was `Vcs.Result` to `Vcs.Rresult` and introduce `Vcs.Result` whose type is simpler (#33, @mbarbin). - Moved `ocaml-vcs more-tests` commands at top-level (#28, @mbarbin). @@ -17,8 +16,11 @@ ### Fixed +- Changed some exceptions raised by the `vcs` related libraries to the `Vcs.E` exception (#34, @mbarbin). + ### Removed +- Removed `Vcs.Exn.raise_s` since it is causing `bisect_ppx` unvisitable points (#34, @mbarbin). - Removed package `vcs-arg` and inline what's needed directly in `vcs-command` (#28, @mbarbin). ## 0.0.8 (2024-09-30) diff --git a/lib/vcs/src/graph.ml b/lib/vcs/src/graph.ml index 20afe17..075f45e 100644 --- a/lib/vcs/src/graph.ml +++ b/lib/vcs/src/graph.ml @@ -229,7 +229,7 @@ let refs t = let set_ref t ~rev ~ref_kind = match Hashtbl.find t.revs rev with - | None -> raise_s [%sexp "Rev not found", (rev : Rev.t)] + | None -> raise (Exn0.E (Err.create_s [%sexp "Rev not found", (rev : Rev.t)])) | Some index -> Hashtbl.set t.refs ~key:ref_kind ~data:index; Hashtbl.add_multi t.reverse_refs ~key:index ~data:ref_kind @@ -497,7 +497,11 @@ let rec summary t = let check_index_exn t ~index = let node_count = node_count t in if index < 0 || index >= node_count - then raise_s [%sexp "Node index out of bounds", { index : int; node_count : int }] + then + raise + (Exn0.E + (Err.create_s + [%sexp "Node index out of bounds", { index : int; node_count : int }])) ;; let get_node_exn t ~index = diff --git a/lib/vcs/src/vcs_exn.ml b/lib/vcs/src/vcs_exn.ml index 44a36d7..b111e33 100644 --- a/lib/vcs/src/vcs_exn.ml +++ b/lib/vcs/src/vcs_exn.ml @@ -23,10 +23,6 @@ let reraise_with_context err bt ~step = Stdlib.Printexc.raise_with_backtrace (Exn0.E (Err.add_context err ~step)) bt ;; -let raise_s msg sexp = - raise (Exn0.E (Err.create_s [%sexp (msg : string), (sexp : Sexp.t)])) -;; - module Private = struct let try_with f = match f () with diff --git a/lib/vcs/src/vcs_exn.mli b/lib/vcs/src/vcs_exn.mli index 54f87a2..2ad98c9 100644 --- a/lib/vcs/src/vcs_exn.mli +++ b/lib/vcs/src/vcs_exn.mli @@ -45,10 +45,6 @@ ]} *) val reraise_with_context : Err.t -> Stdlib.Printexc.raw_backtrace -> step:Sexp.t -> _ -(** Build an err payload from the supplied message and data and raise it as a - {!exception:Vcs.E} exception. *) -val raise_s : string -> Sexp.t -> _ - module Private : sig (** [try_with f] runs [f] and wraps any exception it raises into an {!type:Err.t} error. Because this catches all exceptions, including diff --git a/lib/vcs/test/test__graph.ml b/lib/vcs/test/test__graph.ml index 154f4e5..6b66c7e 100644 --- a/lib/vcs/test/test__graph.ml +++ b/lib/vcs/test/test__graph.ml @@ -443,7 +443,7 @@ let%expect_test "set invalid rev" = ~ref_kind:(Local_branch { branch_name = Vcs.Branch_name.v "main" }) in require_does_raise [%here] (fun () -> set_ref_r1 ()); - [%expect {| ("Rev not found" 5cd237e9598b11065c344d1eb33bc8c15cd237e9) |}]; + [%expect {| (Vcs.E ("Rev not found" 5cd237e9598b11065c344d1eb33bc8c15cd237e9)) |}]; Vcs.Graph.add_nodes graph ~log:[ Root { rev = r1 } ]; set_ref_r1 (); print_s [%sexp (Vcs.Graph.refs graph : Vcs.Refs.t)]; @@ -696,16 +696,18 @@ let%expect_test "debug graph" = require_does_raise [%here] (fun () -> get_node_exn 5); [%expect {| - ("Node index out of bounds" ( - (index 5) - (node_count 5))) + (Vcs.E ( + "Node index out of bounds" ( + (index 5) + (node_count 5)))) |}]; require_does_raise [%here] (fun () -> get_node_exn (-1)); [%expect {| - ("Node index out of bounds" ( - (index -1) - (node_count 5))) + (Vcs.E ( + "Node index out of bounds" ( + (index -1) + (node_count 5)))) |}]; () ;; diff --git a/lib/vcs_command/src/vcs_command.ml b/lib/vcs_command/src/vcs_command.ml index ffbb561..9f90316 100644 --- a/lib/vcs_command/src/vcs_command.ml +++ b/lib/vcs_command/src/vcs_command.ml @@ -39,9 +39,12 @@ let find_enclosing_repo_root vcs ~from = match Vcs.find_enclosing_repo_root vcs ~from ~store:[ Fsegment.dot_git, `Git ] with | Some (`Git, repo_root) -> repo_root | None -> - Vcs.Exn.raise_s - "Failed to locate enclosing repo root from directory" - [%sexp { from : Absolute_path.t }] + raise + (Vcs.E + (Vcs.Err.create_s + [%sexp + "Failed to locate enclosing repo root from directory" + , { from : Absolute_path.t }])) ;; let initialize ~env = @@ -57,7 +60,9 @@ let relativize ~repo_root ~cwd ~path = Absolute_path.chop_prefix path ~prefix:(repo_root |> Vcs.Repo_root.to_absolute_path) with | Some relative_path -> Vcs.Path_in_repo.of_relative_path relative_path - | None -> Vcs.Exn.raise_s "Path is not in repo" [%sexp { path : Absolute_path.t }] + | None -> + raise + (Vcs.E (Vcs.Err.create_s [%sexp "Path is not in repo", { path : Absolute_path.t }])) ;; let add_cmd = @@ -463,13 +468,10 @@ let branch_revision_cmd = with | Some ref -> ref.rev | None -> - (* This line is covered in tests, but we need to disable coverage - reporting here. The reason is that bisect_ppx inserts an unvisitable - coverage point at the out-edge of this raising call, which would - otherwise result in a false negative in our test coverage. *) - Vcs.Exn.raise_s - "Branch not found" - [%sexp { branch_name : Vcs.Branch_name.t }] [@coverage off] + raise + (Vcs.E + (Vcs.Err.create_s + [%sexp "Branch not found", { branch_name : Vcs.Branch_name.t }])) in print_sexp [%sexp (rev : Vcs.Rev.t)]; ()) @@ -492,7 +494,8 @@ let greatest_common_ancestors_cmd = List.map revs ~f:(fun rev -> match Vcs.Graph.find_rev graph ~rev with | Some node -> node - | None -> Vcs.Exn.raise_s "Rev not found" [%sexp { rev : Vcs.Rev.t }]) + | None -> + raise (Vcs.E (Vcs.Err.create_s [%sexp "Rev not found", { rev : Vcs.Rev.t }]))) in let gca = Vcs.Graph.greatest_common_ancestors graph nodes diff --git a/lib/vcs_git_provider/src/log.ml b/lib/vcs_git_provider/src/log.ml index b82180b..a67dfa3 100644 --- a/lib/vcs_git_provider/src/log.ml +++ b/lib/vcs_git_provider/src/log.ml @@ -22,14 +22,29 @@ open! Import let parse_log_line_exn ~line:str : Vcs.Log.Line.t = - match String.split (String.strip str) ~on:' ' with - | [ rev ] -> Root { rev = Vcs.Rev.v rev } - | [ rev; parent ] -> Commit { rev = Vcs.Rev.v rev; parent = Vcs.Rev.v parent } - | [ rev; parent1; parent2 ] -> - Merge - { rev = Vcs.Rev.v rev; parent1 = Vcs.Rev.v parent1; parent2 = Vcs.Rev.v parent2 } - | [] -> assert false - | _ :: _ :: _ :: _ -> raise_s [%sexp "Invalid log line", (str : string)] + match + Vcs.Exn.Private.try_with (fun () -> + match String.split (String.strip str) ~on:' ' with + | [ rev ] -> Vcs.Log.Line.Root { rev = Vcs.Rev.v rev } + | [ rev; parent ] -> Commit { rev = Vcs.Rev.v rev; parent = Vcs.Rev.v parent } + | [ rev; parent1; parent2 ] -> + Merge + { rev = Vcs.Rev.v rev + ; parent1 = Vcs.Rev.v parent1 + ; parent2 = Vcs.Rev.v parent2 + } + | [] -> assert false + | _ :: _ :: _ :: _ -> + raise (Vcs.E (Vcs.Err.error_string "Too many words (expected 1, 2, or 3)"))) + with + | Ok t -> t + | Error err -> + raise + (Vcs.E + (Vcs.Err.add_context + err + ~step: + [%sexp "Vcs_git_provider.Log.parse_log_line_exn", { line = (str : string) }])) ;; module Make (Runtime : Runtime.S) = struct diff --git a/lib/vcs_git_provider/src/munged_path.ml b/lib/vcs_git_provider/src/munged_path.ml index 50171ec..bbeff69 100644 --- a/lib/vcs_git_provider/src/munged_path.ml +++ b/lib/vcs_git_provider/src/munged_path.ml @@ -38,27 +38,29 @@ include T let arrow = lazy (String.Search_pattern.create " => ") let parse_exn str = - try - match String.Search_pattern.split_on (force arrow) str with - | [ str ] -> One_file (Vcs.Path_in_repo.v str) - | [ left; right ] -> - (match String.rsplit2 left ~on:'{' with - | None -> - Two_files { src = Vcs.Path_in_repo.v left; dst = Vcs.Path_in_repo.v right } - | Some (prefix, left_of_arrow) -> - let right_of_arrow, suffix = String.lsplit2_exn right ~on:'}' in - Two_files - { src = Vcs.Path_in_repo.v (prefix ^ left_of_arrow ^ suffix) - ; dst = Vcs.Path_in_repo.v (prefix ^ right_of_arrow ^ suffix) - }) - | _ :: _ :: _ -> raise_s [%sexp "Too many '=>'"] [@coverage off] - | [] -> assert false + match + Vcs.Exn.Private.try_with (fun () -> + match String.Search_pattern.split_on (force arrow) str with + | [ str ] -> One_file (Vcs.Path_in_repo.v str) + | [ left; right ] -> + (match String.rsplit2 left ~on:'{' with + | None -> + Two_files { src = Vcs.Path_in_repo.v left; dst = Vcs.Path_in_repo.v right } + | Some (prefix, left_of_arrow) -> + let right_of_arrow, suffix = String.lsplit2_exn right ~on:'}' in + Two_files + { src = Vcs.Path_in_repo.v (prefix ^ left_of_arrow ^ suffix) + ; dst = Vcs.Path_in_repo.v (prefix ^ right_of_arrow ^ suffix) + }) + | _ :: _ :: _ -> raise (Vcs.E (Vcs.Err.error_string "Too many '=>'")) + | [] -> assert false) with - | exn -> - raise_s - [%sexp - "Vcs_git_provider.Munged_path.parse_exn" - , "invalid path" - , (str : string) - , (exn : Exn.t)] + | Ok t -> t + | Error err -> + raise + (Vcs.E + (Vcs.Err.add_context + err + ~step: + [%sexp "Vcs_git_provider.Munged_path.parse_exn", { path = (str : string) }])) ;; diff --git a/lib/vcs_git_provider/src/name_status.ml b/lib/vcs_git_provider/src/name_status.ml index b86df70..7142f93 100644 --- a/lib/vcs_git_provider/src/name_status.ml +++ b/lib/vcs_git_provider/src/name_status.ml @@ -46,7 +46,7 @@ module Diff_status = struct let parse_exn str : t = if String.is_empty str - then raise_s [%sexp "Unexpected empty diff status"] [@coverage off]; + then raise (Vcs.E (Vcs.Err.error_string "Unexpected empty diff status")); match str.[0] with | 'A' -> `A | 'D' -> `D @@ -64,30 +64,42 @@ module Diff_status = struct end let parse_line_exn ~line : Vcs.Name_status.Change.t = - match String.split line ~on:'\t' with - | [] -> assert false - | [ _ ] -> raise_s [%sexp "Unexpected output from git status", (line : string)] - | status :: path :: rest -> - (match Diff_status.parse_exn status with - | `A -> Added (Vcs.Path_in_repo.v path) - | `D -> Removed (Vcs.Path_in_repo.v path) - | `M -> Modified (Vcs.Path_in_repo.v path) - | (`R | `C) as diff_status -> - let similarity = - String.sub status ~pos:1 ~len:(String.length status - 1) |> Int.of_string - in - let path2 = - match List.hd rest with - | Some hd -> Vcs.Path_in_repo.v hd - | None -> - raise_s - [%sexp "Unexpected output from git status", (line : string)] [@coverage off] - in - (match diff_status with - | `R -> Renamed { src = Vcs.Path_in_repo.v path; dst = path2; similarity } - | `C -> Copied { src = Vcs.Path_in_repo.v path; dst = path2; similarity }) - | other -> - raise_s [%sexp "Unexpected status", (status : string), (other : Diff_status.t)]) + match + Vcs.Exn.Private.try_with (fun () -> + match String.split line ~on:'\t' with + | [] -> assert false + | [ _ ] -> raise (Vcs.E (Vcs.Err.error_string "Unexpected output from git status")) + | status :: path :: rest -> + (match Diff_status.parse_exn status with + | `A -> Vcs.Name_status.Change.Added (Vcs.Path_in_repo.v path) + | `D -> Removed (Vcs.Path_in_repo.v path) + | `M -> Modified (Vcs.Path_in_repo.v path) + | (`R | `C) as diff_status -> + let similarity = + String.sub status ~pos:1 ~len:(String.length status - 1) |> Int.of_string + in + let path2 = + match List.hd rest with + | Some hd -> Vcs.Path_in_repo.v hd + | None -> + raise (Vcs.E (Vcs.Err.error_string "Unexpected output from git status")) + in + (match diff_status with + | `R -> Renamed { src = Vcs.Path_in_repo.v path; dst = path2; similarity } + | `C -> Copied { src = Vcs.Path_in_repo.v path; dst = path2; similarity }) + | other -> + raise + (Vcs.E + (Vcs.Err.create_s + [%sexp "Unexpected status", (status : string), (other : Diff_status.t)])))) + with + | Ok t -> t + | Error err -> + raise + (Vcs.E + (Vcs.Err.add_context + err + ~step:[%sexp "Vcs_git_provider.Name_status.parse_line_exn", { line : string }])) ;; let parse_lines_exn ~lines = List.map lines ~f:(fun line -> parse_line_exn ~line) diff --git a/lib/vcs_git_provider/src/num_status.ml b/lib/vcs_git_provider/src/num_status.ml index 66e6921..8c10fad 100644 --- a/lib/vcs_git_provider/src/num_status.ml +++ b/lib/vcs_git_provider/src/num_status.ml @@ -44,23 +44,35 @@ module Status_code = struct end let parse_line_exn ~line : Vcs.Num_status.Change.t = - match String.split line ~on:'\t' with - | [] -> assert false - | [ _ ] | [ _; _ ] | _ :: _ :: _ :: _ :: _ -> - raise_s [%sexp "Unexpected output from git diff", (line : string)] - | [ insertions; deletions; munged_path ] -> - { Vcs.Num_status.Change.key = Munged_path.parse_exn munged_path - ; num_stat = - (match Status_code.parse insertions, Status_code.parse deletions with - | Dash, Dash -> Binary_file - | Num insertions, Num deletions -> Num_lines_in_diff { insertions; deletions } - | insertions, deletions -> - raise_s - [%sexp - "Unexpected output from git diff" - , { line : string; insertions : Status_code.t; deletions : Status_code.t }] - [@coverage off]) - } + match + Vcs.Exn.Private.try_with (fun () -> + match String.split line ~on:'\t' with + | [] -> assert false + | [ _ ] | [ _; _ ] | _ :: _ :: _ :: _ :: _ -> + raise (Vcs.E (Vcs.Err.error_string "Unexpected output from git diff")) + | [ insertions; deletions; munged_path ] -> + { Vcs.Num_status.Change.key = Munged_path.parse_exn munged_path + ; num_stat = + (match Status_code.parse insertions, Status_code.parse deletions with + | Dash, Dash -> Binary_file + | Num insertions, Num deletions -> + Num_lines_in_diff { insertions; deletions } + | insertions, deletions -> + raise + (Vcs.E + (Vcs.Err.create_s + [%sexp + "Unexpected output from git diff" + , { insertions : Status_code.t; deletions : Status_code.t }]))) + }) + with + | Ok t -> t + | Error err -> + raise + (Vcs.E + (Vcs.Err.add_context + err + ~step:[%sexp "Vcs_git_provider.Num_status.parse_line_exn", { line : string }])) ;; let parse_lines_exn ~lines = List.map lines ~f:(fun line -> parse_line_exn ~line) diff --git a/lib/vcs_git_provider/src/refs.ml b/lib/vcs_git_provider/src/refs.ml index 0cf2df3..56c4808 100644 --- a/lib/vcs_git_provider/src/refs.ml +++ b/lib/vcs_git_provider/src/refs.ml @@ -21,6 +21,31 @@ open! Import +let parse_ref_kind_exn str : Vcs.Ref_kind.t = + match + Vcs.Exn.Private.try_with (fun () -> + let str = String.chop_prefix_exn str ~prefix:"refs/" in + match String.lsplit2 str ~on:'/' with + | None -> Vcs.Ref_kind.Other { name = str } + | Some (kind, name) -> + (match kind with + | "heads" -> Local_branch { branch_name = Vcs.Branch_name.v name } + | "remotes" -> + Remote_branch { remote_branch_name = Vcs.Remote_branch_name.v name } + | "tags" -> Tag { tag_name = Vcs.Tag_name.v name } + | _ -> Other { name = str })) + with + | Ok t -> t + | Error err -> + raise + (Vcs.E + (Vcs.Err.add_context + err + ~step: + [%sexp + "Vcs_git_provider.Refs.parse_ref_kind_exn", { ref_kind = (str : string) }])) +;; + module Dereferenced = struct module T = struct [@@@coverage off] @@ -48,27 +73,34 @@ module Dereferenced = struct include T - let parse_ref_kind_exn str : Vcs.Ref_kind.t = - let str = String.chop_prefix_exn str ~prefix:"refs/" in - match String.lsplit2 str ~on:'/' with - | None -> Other { name = str } - | Some (kind, name) -> - (match kind with - | "heads" -> Local_branch { branch_name = Vcs.Branch_name.v name } - | "remotes" -> Remote_branch { remote_branch_name = Vcs.Remote_branch_name.v name } - | "tags" -> Tag { tag_name = Vcs.Tag_name.v name } - | _ -> Other { name = str }) - ;; - let parse_exn ~line:str = - match String.lsplit2 str ~on:' ' with - | None -> raise_s [%sexp "Invalid ref line", (str : string)] - | Some (rev, ref_) -> - (match String.chop_suffix ref_ ~suffix:"^{}" with - | Some ref_ -> - { rev = Vcs.Rev.v rev; ref_kind = parse_ref_kind_exn ref_; dereferenced = true } - | None -> - { rev = Vcs.Rev.v rev; ref_kind = parse_ref_kind_exn ref_; dereferenced = false }) + match + Vcs.Exn.Private.try_with (fun () -> + match String.lsplit2 str ~on:' ' with + | None -> raise (Vcs.E (Vcs.Err.error_string "Invalid ref line")) + | Some (rev, ref_) -> + (match String.chop_suffix ref_ ~suffix:"^{}" with + | Some ref_ -> + { rev = Vcs.Rev.v rev + ; ref_kind = parse_ref_kind_exn ref_ + ; dereferenced = true + } + | None -> + { rev = Vcs.Rev.v rev + ; ref_kind = parse_ref_kind_exn ref_ + ; dereferenced = false + })) + with + | Ok t -> t + | Error err -> + raise + (Vcs.E + (Vcs.Err.add_context + err + ~step: + [%sexp + "Vcs_git_provider.Refs.Dereferenced.parse_exn" + , { line = (str : string) }])) ;; end diff --git a/lib/vcs_git_provider/src/refs.mli b/lib/vcs_git_provider/src/refs.mli index cfefe40..a0812e1 100644 --- a/lib/vcs_git_provider/src/refs.mli +++ b/lib/vcs_git_provider/src/refs.mli @@ -31,6 +31,8 @@ end This is exposed for tests and low-level usage. *) +val parse_ref_kind_exn : string -> Vcs.Ref_kind.t + module Dereferenced : sig type t = { rev : Vcs.Rev.t @@ -40,7 +42,6 @@ module Dereferenced : sig [@@deriving sexp_of] val equal : t -> t -> bool - val parse_ref_kind_exn : string -> Vcs.Ref_kind.t val parse_exn : line:string -> t end diff --git a/lib/vcs_git_provider/test/test__log.ml b/lib/vcs_git_provider/test/test__log.ml index cc0013c..8bbec3f 100644 --- a/lib/vcs_git_provider/test/test__log.ml +++ b/lib/vcs_git_provider/test/test__log.ml @@ -78,14 +78,24 @@ let%expect_test "invalid lines" = (parent1 aff8c9c8601e68a41a3bb695ea4a276e2446061f) (parent2 d3a24cbfad0a681280ecfe021d40b69fb0b9c589)) |}]; require_does_raise [%here] (fun () -> test ""); - [%expect {| (Invalid_argument "\"\": invalid rev") |}]; + [%expect + {| + (Vcs.E ( + (steps ((Vcs_git_provider.Log.parse_log_line_exn ((line ""))))) + (error (Invalid_argument "\"\": invalid rev")))) + |}]; require_does_raise [%here] (fun () -> test "3bf5092cc55bff4c3ba546c771e17ab8d29cce65 aff8c9c8601e68a41a3bb695ea4a276e2446061f \ d3a24cbfad0a681280ecfe021d40b69fb0b9c589 3509268b3f47a9e081bf11ac5e59f8b6eac6109b"); [%expect {| - ("Invalid log line" - "3bf5092cc55bff4c3ba546c771e17ab8d29cce65 aff8c9c8601e68a41a3bb695ea4a276e2446061f d3a24cbfad0a681280ecfe021d40b69fb0b9c589 3509268b3f47a9e081bf11ac5e59f8b6eac6109b") |}]; + (Vcs.E ( + (steps (( + Vcs_git_provider.Log.parse_log_line_exn (( + line + "3bf5092cc55bff4c3ba546c771e17ab8d29cce65 aff8c9c8601e68a41a3bb695ea4a276e2446061f d3a24cbfad0a681280ecfe021d40b69fb0b9c589 3509268b3f47a9e081bf11ac5e59f8b6eac6109b"))))) + (error "Too many words (expected 1, 2, or 3)"))) + |}]; () ;; diff --git a/lib/vcs_git_provider/test/test__munged_path.ml b/lib/vcs_git_provider/test/test__munged_path.ml index 2401c11..1667b63 100644 --- a/lib/vcs_git_provider/test/test__munged_path.ml +++ b/lib/vcs_git_provider/test/test__munged_path.ml @@ -26,26 +26,25 @@ let%expect_test "parse" = require_does_raise [%here] (fun () -> test ""); [%expect {| - (Vcs_git_provider.Munged_path.parse_exn - "invalid path" - "" - (Invalid_argument "\"\": invalid path")) + (Vcs.E ( + (steps ((Vcs_git_provider.Munged_path.parse_exn ((path ""))))) + (error (Invalid_argument "\"\": invalid path")))) |}]; require_does_raise [%here] (fun () -> test "/tmp => /tmp"); [%expect {| - (Vcs_git_provider.Munged_path.parse_exn - "invalid path" - "/tmp => /tmp" - (Invalid_argument "\"/tmp\": not a relative path")) + (Vcs.E ( + (steps ((Vcs_git_provider.Munged_path.parse_exn ((path "/tmp => /tmp"))))) + (error (Invalid_argument "\"/tmp\": not a relative path")))) |}]; require_does_raise [%here] (fun () -> test "tmp => tmp2 => tmp3"); [%expect {| - (Vcs_git_provider.Munged_path.parse_exn - "invalid path" - "tmp => tmp2 => tmp3" - "Too many '=>'") |}]; + (Vcs.E ( + (steps (( + Vcs_git_provider.Munged_path.parse_exn ((path "tmp => tmp2 => tmp3"))))) + (error "Too many '=>'"))) + |}]; test "a/simple/path"; [%expect {| (One_file a/simple/path) |}]; test "a/simple/path => another/path"; diff --git a/lib/vcs_git_provider/test/test__name_status.ml b/lib/vcs_git_provider/test/test__name_status.ml index bee7d56..de0f32e 100644 --- a/lib/vcs_git_provider/test/test__name_status.ml +++ b/lib/vcs_git_provider/test/test__name_status.ml @@ -191,8 +191,7 @@ let%expect_test "Diff_status" = (Z Not_supported) |}]; require_does_raise [%here] (fun () -> Vcs_git_provider.Name_status.Diff_status.parse_exn ""); - [%expect {| - "Unexpected empty diff status" |}]; + [%expect {| (Vcs.E "Unexpected empty diff status") |}]; () ;; @@ -224,32 +223,91 @@ let%expect_test "parse_lines_exn" = print_s [%sexp (line : string), (result : Vcs.Name_status.Change.t Or_error.t)]); [%expect {| - ("" (Error ("Unexpected output from git status" ""))) - (file (Error ("Unexpected output from git status" file))) + ("" ( + Error ( + Vcs.E ( + (steps ((Vcs_git_provider.Name_status.parse_line_exn ((line ""))))) + (error "Unexpected output from git status"))))) + (file ( + Error ( + Vcs.E ( + (steps ((Vcs_git_provider.Name_status.parse_line_exn ((line file))))) + (error "Unexpected output from git status"))))) ("A\tfile1" (Ok (Added file1))) ("D\tfile2" (Ok (Removed file2))) ("M\tfile3" (Ok (Modified file3))) - ("U\tfile4" (Error ("Unexpected status" U U))) - ("Q\tfile5" (Error ("Unexpected status" Q Q))) - ("I\tfile6" (Error ("Unexpected status" I I))) - ("?\tfile7" (Error ("Unexpected status" ? Question_mark))) - ("!\tfile8" (Error ("Unexpected status" ! Bang))) - ("X\tfile9" (Error ("Unexpected status" X X))) - ("R\tfile10" (Error (Failure "Int.of_string: \"\""))) - ("R35\tfile10" (Error ("Unexpected output from git status" "R35\tfile10"))) + ("U\tfile4" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "U\tfile4"))))) + (error ("Unexpected status" U U)))))) + ("Q\tfile5" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "Q\tfile5"))))) + (error ("Unexpected status" Q Q)))))) + ("I\tfile6" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "I\tfile6"))))) + (error ("Unexpected status" I I)))))) + ("?\tfile7" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "?\tfile7"))))) + (error ("Unexpected status" ? Question_mark)))))) + ("!\tfile8" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "!\tfile8"))))) + (error ("Unexpected status" ! Bang)))))) + ("X\tfile9" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "X\tfile9"))))) + (error ("Unexpected status" X X)))))) + ("R\tfile10" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "R\tfile10"))))) + (error (Failure "Int.of_string: \"\"")))))) + ("R35\tfile10" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "R35\tfile10"))))) + (error "Unexpected output from git status"))))) ("R35\tfile1\tfile2" ( Ok ( Renamed (src file1) (dst file2) (similarity 35)))) - ("C\tfile11" (Error (Failure "Int.of_string: \"\""))) + ("C\tfile11" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "C\tfile11"))))) + (error (Failure "Int.of_string: \"\"")))))) ("C75\tfile1\tfile2" ( Ok ( Copied (src file1) (dst file2) (similarity 75)))) - ("Z\tfile12" (Error ("Unexpected status" Z Not_supported))) |}]; + ("Z\tfile12" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Name_status.parse_line_exn ((line "Z\tfile12"))))) + (error ("Unexpected status" Z Not_supported)))))) + |}]; () ;; diff --git a/lib/vcs_git_provider/test/test__num_status.ml b/lib/vcs_git_provider/test/test__num_status.ml index e1cf640..95910d1 100644 --- a/lib/vcs_git_provider/test/test__num_status.ml +++ b/lib/vcs_git_provider/test/test__num_status.ml @@ -468,6 +468,7 @@ let%expect_test "parse_lines_exn" = ; "-\t10\tfile" ; "7\t-\tfile" ; "-2\t-10\tfile" + ; "1985\t0\tfile1 => /tmp/file2" ] in List.iter lines ~f:(fun line -> @@ -477,16 +478,35 @@ let%expect_test "parse_lines_exn" = print_s [%sexp (line : string), (result : Vcs.Num_status.Change.t Or_error.t)]); [%expect {| - ("" (Error ("Unexpected output from git diff" ""))) - (file (Error ("Unexpected output from git diff" file))) - ("A\tB" (Error ("Unexpected output from git diff" "A\tB"))) - ("A\tB\tC\tD" (Error ("Unexpected output from git diff" "A\tB\tC\tD"))) + ("" ( + Error ( + Vcs.E ( + (steps ((Vcs_git_provider.Num_status.parse_line_exn ((line ""))))) + (error "Unexpected output from git diff"))))) + (file ( + Error ( + Vcs.E ( + (steps ((Vcs_git_provider.Num_status.parse_line_exn ((line file))))) + (error "Unexpected output from git diff"))))) + ("A\tB" ( + Error ( + Vcs.E ( + (steps ((Vcs_git_provider.Num_status.parse_line_exn ((line "A\tB"))))) + (error "Unexpected output from git diff"))))) + ("A\tB\tC\tD" ( + Error ( + Vcs.E ( + (steps (( + Vcs_git_provider.Num_status.parse_line_exn ((line "A\tB\tC\tD"))))) + (error "Unexpected output from git diff"))))) ("A\tB\tC" ( Error ( - "Unexpected output from git diff" ( - (line "A\tB\tC") - (insertions (Other A)) - (deletions (Other B)))))) + Vcs.E ( + (steps ((Vcs_git_provider.Num_status.parse_line_exn ((line "A\tB\tC"))))) + (error ( + "Unexpected output from git diff" ( + (insertions (Other A)) + (deletions (Other B))))))))) ("0\t1\tfile" ( Ok ( (key (One_file file)) @@ -517,20 +537,37 @@ let%expect_test "parse_lines_exn" = ("-\t-\tfile" (Ok ((key (One_file file)) (num_stat Binary_file)))) ("-\t10\tfile" ( Error ( - "Unexpected output from git diff" ( - (line "-\t10\tfile") - (insertions Dash) - (deletions (Num 10)))))) + Vcs.E ( + (steps (( + Vcs_git_provider.Num_status.parse_line_exn ((line "-\t10\tfile"))))) + (error ( + "Unexpected output from git diff" ( + (insertions Dash) (deletions (Num 10))))))))) ("7\t-\tfile" ( Error ( - "Unexpected output from git diff" ( - (line "7\t-\tfile") (insertions (Num 7)) (deletions Dash))))) + Vcs.E ( + (steps (( + Vcs_git_provider.Num_status.parse_line_exn ((line "7\t-\tfile"))))) + (error ( + "Unexpected output from git diff" ( + (insertions (Num 7)) (deletions Dash)))))))) ("-2\t-10\tfile" ( Error ( - "Unexpected output from git diff" ( - (line "-2\t-10\tfile") - (insertions (Other -2)) - (deletions (Other -10)))))) + Vcs.E ( + (steps (( + Vcs_git_provider.Num_status.parse_line_exn ((line "-2\t-10\tfile"))))) + (error ( + "Unexpected output from git diff" ( + (insertions (Other -2)) + (deletions (Other -10))))))))) + ("1985\t0\tfile1 => /tmp/file2" ( + Error ( + Vcs.E ( + (steps ( + (Vcs_git_provider.Num_status.parse_line_exn + ((line "1985\t0\tfile1 => /tmp/file2"))) + (Vcs_git_provider.Munged_path.parse_exn ((path "file1 => /tmp/file2"))))) + (error (Invalid_argument "\"/tmp/file2\": not a relative path")))))) |}]; () ;; diff --git a/lib/vcs_git_provider/test/test__refs.ml b/lib/vcs_git_provider/test/test__refs.ml index 55b095f..1cbf338 100644 --- a/lib/vcs_git_provider/test/test__refs.ml +++ b/lib/vcs_git_provider/test/test__refs.ml @@ -55,11 +55,25 @@ let%expect_test "parse_exn" = let%expect_test "parse_ref_kind_exn" = let test_ref_kind str = - print_s - [%sexp (Vcs_git_provider.Refs.Dereferenced.parse_ref_kind_exn str : Vcs.Ref_kind.t)] + print_s [%sexp (Vcs_git_provider.Refs.parse_ref_kind_exn str : Vcs.Ref_kind.t)] in require_does_raise [%here] (fun () -> test_ref_kind "blah"); - [%expect {| (Invalid_argument "String.chop_prefix_exn \"blah\" \"refs/\"") |}]; + [%expect + {| + (Vcs.E ( + (steps ((Vcs_git_provider.Refs.parse_ref_kind_exn ((ref_kind blah))))) + (error (Invalid_argument "String.chop_prefix_exn \"blah\" \"refs/\"")))) + |}]; + require_does_raise [%here] (fun () -> test_ref_kind "non-refs/tags/0.0.1"); + [%expect + {| + (Vcs.E ( + (steps (( + Vcs_git_provider.Refs.parse_ref_kind_exn ((ref_kind non-refs/tags/0.0.1))))) + (error ( + Invalid_argument + "String.chop_prefix_exn \"non-refs/tags/0.0.1\" \"refs/\"")))) + |}]; test_ref_kind "refs/blah"; [%expect {| (Other (name blah)) |}]; test_ref_kind "refs/blah/blah"; @@ -67,7 +81,13 @@ let%expect_test "parse_ref_kind_exn" = test_ref_kind "refs/heads/blah"; [%expect {| (Local_branch (branch_name blah)) |}]; require_does_raise [%here] (fun () -> test_ref_kind "refs/remotes/blah"); - [%expect {| (Invalid_argument "\"blah\": invalid remote_branch_name") |}]; + [%expect + {| + (Vcs.E ( + (steps (( + Vcs_git_provider.Refs.parse_ref_kind_exn ((ref_kind refs/remotes/blah))))) + (error (Invalid_argument "\"blah\": invalid remote_branch_name")))) + |}]; test_ref_kind "refs/remotes/origin/main"; [%expect {| @@ -88,7 +108,12 @@ let%expect_test "dereferenced" = : Vcs_git_provider.Refs.Dereferenced.t)] in require_does_raise [%here] (fun () -> test ""); - [%expect {| ("Invalid ref line" "") |}]; + [%expect + {| + (Vcs.E ( + (steps ((Vcs_git_provider.Refs.Dereferenced.parse_exn ((line ""))))) + (error "Invalid ref line"))) + |}]; test "1185512b92d612b25613f2e5b473e5231185512b refs/heads/main"; [%expect {|