Improve potentially used backtraces and discard unused backtraces

src/client/opamCommands.ml

@@ -473,8 +473,8 @@ let init cli =
           match OpamStateConfig.load ~lock_kind:`Lock_write root with
           | Some c -> c
           | exception (OpamPp.Bad_version _ as e) ->
+            OpamStd.Exn.finalise e @@ fun () ->
             OpamFormatUpgrade.hard_upgrade_from_2_1_intermediates ~reinit root;
-            raise e
           | None -> OpamFile.Config.empty
         in
         reinit config
@@ -4019,11 +4019,11 @@ let lint cli =
                  Printf.sprintf "<pinned>/%s" (OpamPackage.to_string nv)
                in
                [`pkg (file, label)]
-             | None -> raise Not_found
+             | None -> raise_notrace Not_found
            else
              let opam = OpamSwitchState.opam st nv in
              match OpamPinned.orig_opam_file st name opam with
-             | None -> raise Not_found
+             | None -> raise_notrace Not_found
              | Some file ->
                let repo, label =
                  let repo, reponame =

src/client/opamConfigCommand.ml

@@ -515,7 +515,7 @@ let parse_update fv =
       | ("=" | "=="), None -> `Revert
       | ("+=" | "-="), None -> raise (Invalid_argument "parse_update: rhs needed")
       | _, _ -> raise (Invalid_argument "parse_update: illegal operator")
-    with Not_found ->  raise (Invalid_argument "parse_update: operator needed")
+    with Not_found -> raise (Invalid_argument "parse_update: operator needed")
   in
   var, value
 
@@ -757,8 +757,8 @@ let with_switch ~display gt lock_kind st k =
           match OpamStateConfig.Switch.read_opt ~lock_kind gt switch with
           | Some c -> c
           | exception (OpamPp.Bad_version _ as e) ->
+            OpamStd.Exn.finalise e @@ fun () ->
             OpamFormatUpgrade.hard_upgrade_from_2_1_intermediates gt.root;
-            raise e
           | None -> OpamFile.Switch_config.empty
         else
           OpamStateConfig.Switch.safe_load ~lock_kind gt switch

src/client/opamListCommand.ml

@@ -599,7 +599,7 @@ let detail_printer ?prettify ?normalise ?(sort=false) installed st nv =
          | "url.swhid" ->
            (match OpamFile.(OPAM.url opam >>= URL.swhid) with
             | Some f -> OpamTypesBase.nullify_pos (String (OpamSWHID.to_string f))
-            | None -> raise Not_found)
+            | None -> raise_notrace Not_found)
          | "url.mirrors" ->
            OpamFile.(OPAM.with_url_opt
                        (OPAM.url opam >>| URL.with_swhid_opt None)

src/client/opamSolution.ml

@@ -924,22 +924,22 @@ let parallel_apply t
     OpamConsole.msg "Done.\n";
     t, OK successful
   | `Exception (OpamStd.Sys.Exit _ | Sys.Break as e) ->
+    OpamStd.Exn.finalise e @@ fun () ->
     OpamConsole.msg "Aborting.\n";
-    raise e
   | `Exception (OpamSolver.ActionGraph.Parallel.Cyclic cycles as e) ->
+    OpamStd.Exn.finalise e @@ fun () ->
     OpamConsole.error "Cycles found during dependency resolution:\n%s"
       (OpamStd.Format.itemize
          (OpamStd.List.concat_map (OpamConsole.colorise `yellow " -> ")
             OpamSolver.Action.to_string)
          cycles);
-    raise e
   | `Exception (OpamSystem.Process_error _ | Unix.Unix_error _ as e) ->
+    OpamStd.Exn.finalise e @@ fun () ->
     OpamConsole.error "Actions cancelled because of a system error:";
     OpamConsole.errmsg "%s\n" (Printexc.to_string e);
-    raise e
   | `Exception e ->
+    OpamStd.Exn.finalise e @@ fun () ->
     OpamConsole.error "Actions cancelled because of %s" (Printexc.to_string e);
-    raise e
   | `Error err ->
     match err with
     | Aborted -> t, err

src/client/opamSwitchCommand.ml

@@ -695,13 +695,14 @@ let import st ?deps_only filename =
   let importfile =
     try OpamFile.SwitchExport.read_from_string ?filename import_str
     with OpamPp.Bad_format _ as e ->
+      let bt = Printexc.get_raw_backtrace () in
       log "Error loading export file, trying the old file format";
       try
         let selections = OpamFile.LegacyState.read_from_string import_str in
         { OpamFile.SwitchExport.selections;
           extra_files = OpamHash.Map.empty;
           overlays = OpamPackage.Name.Map.empty }
-      with e1 -> OpamStd.Exn.fatal e1; raise e
+      with e1 -> OpamStd.Exn.fatal e1; Printexc.raise_with_backtrace e bt
   in
   import_t ?deps_only importfile st
 
@@ -765,7 +766,7 @@ let guess_compiler_invariant ?repos rt strings =
           if OpamPackage.Set.exists (OpamFormula.check atom)
               (OpamPackage.packages_of_name packages name)
           then OpamFormula.ands [acc; Atom atom]
-          else raise Not_found
+          else raise_notrace Not_found
         with Failure _ | Not_found ->
         try
           let v = OpamPackage.Version.of_string str in
@@ -778,7 +779,7 @@ let guess_compiler_invariant ?repos rt strings =
             if OpamPackage.Set.is_empty candidates then
               let avoided_candidates = filter removed_compiler_packages in
               if OpamPackage.Set.is_empty avoided_candidates then
-                raise Not_found
+                raise_notrace Not_found
               else
                 (if not (OpamPackage.Set.is_singleton avoided_candidates) then
                    OpamConsole.note

src/core/opamConsole.ml

@@ -742,13 +742,13 @@ let short_user_input ~prompt ?default ?on_eof f =
         match
           (* Some keystrokes, e.g. arrows, can return 3 chars *)
           let nr = read stdin buf 0 3 in
-          if nr < 1 then raise End_of_file
+          if nr < 1 then raise_notrace End_of_file
           else String.uncapitalize_ascii (Bytes.sub_string buf 0 nr)
         with
         | "\n" -> default
         | s -> Some s
         | exception Unix.Unix_error (Unix.EINTR,_,_) -> None
-        | exception Unix.Unix_error _ -> raise End_of_file
+        | exception Unix.Unix_error _ -> raise_notrace End_of_file
       in
       match input with
       | None -> loop ()
@@ -827,7 +827,7 @@ let read fmt =
         | End_of_file ->
           msg "\n";
           None
-        | Sys.Break as e -> msg "\n"; raise e
+        | Sys.Break as e -> OpamStd.Exn.finalise e (fun () -> msg "\n")
       ) else
         None
     ) fmt
@@ -994,11 +994,10 @@ let menu ?default ?unsafe_yes ?yes ~no ~options fmt =
     | `all_no, _, _ -> print_string prompt; select no
     | _, _, _ ->
       let default_ref = ref default in
-      let change_selection =
-        fun opt ->
-          rollback_terminal nlines; (* restore cursor pos *)
-          default_ref := opt;
-          raise Exit
+      let change_selection opt =
+        rollback_terminal nlines; (* restore cursor pos *)
+        default_ref := opt;
+        raise_notrace Exit
       in
       try
         short_user_input ~prompt ~default:default_s ~on_eof:no_s @@ function

src/core/opamDirTrack.ml

@@ -81,7 +81,7 @@ let cached_digest =
     try
       let csize, cmtime, digest = Hashtbl.find item_cache f in
       if csize = size && mtime = cmtime then Digest.to_hex digest
-      else raise Not_found
+      else raise_notrace Not_found
     with Not_found ->
       let digest = Digest.file f in
       Hashtbl.replace item_cache f (size, mtime, digest);

src/core/opamFilename.ml

@@ -703,8 +703,8 @@ module Attribute = struct
             if not (OpamStd.List.mem_assoc String.equal "perm" dict) then None
             else match OpamStd.List.assoc String.equal "perm" dict with
               | `String hash ->
-                (try Some (int_of_string hash) with _ -> raise Not_found)
-              | _ -> raise Not_found
+                (try Some (int_of_string hash) with _ -> raise_notrace Not_found)
+              | _ -> raise_notrace Not_found
           in
           Some { base; md5; perm }
         with Not_found -> None

src/core/opamJson.ml

@@ -21,7 +21,7 @@ type 'a decoder = t -> 'a option
 let of_string ?encoding str =
   let dec d = match Jsonm.decode d with
     | `Lexeme l -> l
-    | `Error _ -> raise Exit
+    | `Error _ -> raise_notrace Exit
     | `End | `Await -> assert false
   in
   let rec value v k d = match v with

src/core/opamParallel.ml

@@ -435,24 +435,24 @@ module MakeGraph (X: VERTEX) = struct
           let vertices_json =
             match OpamStd.List.assoc String.equal "vertices" dict with
             | `O vertices -> vertices
-            | _ -> raise Not_found in
+            | _ -> raise_notrace Not_found in
           let edges_json =
             match OpamStd.List.assoc String.equal "edges" dict with
             | `A edges -> edges
-            | _ -> raise Not_found in
+            | _ -> raise_notrace Not_found in
           let vertex_map =
             let vertex_of_json (ij, vj) =
-              let i = try int_of_string ij with _ -> raise Not_found in
+              let i = try int_of_string ij with _ -> raise_notrace Not_found in
               let v = match X.of_json vj with
-                  | None -> raise Not_found
+                  | None -> raise_notrace Not_found
                   | Some v -> v in
               (i, v) in
             List.map vertex_of_json vertices_json
           in
           let edges =
             let int_of_jsonstring = function
-              | `String s -> (try int_of_string s with _ -> raise Not_found)
-              | _ -> raise Not_found in
+              | `String s -> (try int_of_string s with _ -> raise_notrace Not_found)
+              | _ -> raise_notrace Not_found in
             let find kj =
               OpamStd.List.assoc Int.equal (int_of_jsonstring kj) vertex_map
             in
@@ -462,7 +462,7 @@ module MakeGraph (X: VERTEX) = struct
                 let label = () in
                 let dst = find (OpamStd.List.assoc String.equal "dst" dict) in
                 E.create src label dst
-              | _ -> raise Not_found
+              | _ -> raise_notrace Not_found
             in List.map edge_of_json edges_json
           in
           Some (build (List.map snd vertex_map) edges)

src/core/opamProcess.ml

@@ -402,7 +402,7 @@ let create ?info_file ?env_file ?(allow_stdin=not Sys.win32) ?stdout_file ?stder
             else if Sys.file_exists (cmd ^ ".exe") then
               cmd ^ ".exe"
             else
-              raise Exit in
+              raise_notrace Exit in
           let actual_image, args =
             let c = open_in actual_command in
             set_binary_mode_in c true;
@@ -429,15 +429,15 @@ let create ?info_file ?env_file ?(allow_stdin=not Sys.win32) ?stdout_file ?stder
                   cmd, OpamStd.Option.map_default (fun arg -> arg::args) args arg
                 with Not_found ->
                   (* Script interpreter isn't available - fall back *)
-                  raise Exit
+                  raise_notrace Exit
               end else begin
                 close_in c;
                 actual_command, args
               end
             with End_of_file ->
               close_in c;
               (* A two-byte image can't be executable! *)
-              raise Exit in
+              raise_notrace Exit in
           (*Printf.eprintf "Final deduction: %s -> %s\n%!" cmd actual_image;*)
           actual_image, args
         with Exit ->
@@ -452,10 +452,11 @@ let create ?info_file ?env_file ?(allow_stdin=not Sys.win32) ?stdout_file ?stder
         env
         stdin_fd stdout_fd stderr_fd
     with e ->
+      OpamStd.Exn.finalise e @@ fun () ->
       close_stdin  ();
       close_stdout ();
       close_stderr ();
-      raise e in
+  in
   close_stdin  ();
   close_stdout ();
   close_stderr ();
@@ -702,7 +703,7 @@ let safe_wait fallback_pid f x =
       | r -> r
   in
   try let r = aux () in cleanup (); r
-  with e -> cleanup (); raise e
+  with e -> OpamStd.Exn.finalise e cleanup
 
 let wait p =
   set_verbose_process p;
@@ -763,11 +764,11 @@ let run command =
   in
   let p = run_background command in
   try wait p with e ->
-    match (try dontwait p with _ -> raise e) with
+    OpamStd.Exn.finalise e @@ fun () ->
+    match dontwait p with
     | None -> (* still running *)
       (try interrupt p with Unix.Unix_error _ -> ());
-      raise e
-    | _ -> raise e
+    | Some _ | exception _ -> ()
 
 let is_failure r = r.r_code <> 0 || r.r_signal <> None
 
@@ -904,9 +905,9 @@ module Job = struct
         let k =
           try cont r
           with e ->
+            OpamStd.Exn.finalise e @@ fun () ->
             cleanup r;
             OpamConsole.clear_status ();
-            raise e
         in
         cleanup r;
         OpamConsole.clear_status ();
@@ -938,7 +939,7 @@ module Job = struct
       | Done x -> fin (); Done x
       | Run (cmd,cont) ->
         Run (cmd, fun r -> finally fin (fun () -> cont r))
-    with e -> fin (); raise e
+    with e -> OpamStd.Exn.finalise e fin
 
   let of_list ?(keep_going=false) l =
     let rec aux err = function

src/core/opamStd.ml

@@ -236,7 +236,7 @@ module Set = struct
     exception Found of elt
 
     let find_opt fn t =
-      try iter (fun x -> if fn x then raise (Found x)) t; None
+      try iter (fun x -> if fn x then raise_notrace (Found x)) t; None
       with Found x -> Some x
 
     let find fn t =
@@ -666,7 +666,7 @@ module OpamString = struct
     try
       String.iter (function
           | '0'..'9' | 'A'..'F' | 'a'..'f' -> ()
-          | _ -> raise Exit)
+          | _ -> raise_notrace Exit)
         s;
       true
     with Exit -> false

src/core/opamSystem.ml

@@ -750,15 +750,15 @@ let classify_executable file =
               | 0x14c ->
                   `x86
               | _ ->
-                  raise End_of_file
+                  raise_notrace End_of_file
             in
             let _ : string = really_input_string c 14 in
             let size_of_opt_header = input_short_little c in
             let characteristics = input_short_little c in
             (* Executable images must have a PE "optional" header and be marked executable *)
             (* Could also validate IMAGE_FILE_32BIT_MACHINE (0x100) for x86 and IMAGE_FILE_LARGE_ADDRESS_AWARE (0x20) for x64 *)
             if size_of_opt_header <= 0 || characteristics land 0x2 = 0 then
-              raise End_of_file;
+              raise_notrace End_of_file;
             close_in c;
             if characteristics land 0x2000 <> 0 then
               `Dll arch
@@ -1156,7 +1156,7 @@ let rec flock_update
            file (if Sys.win32 then "CTRL+C" else "C-c");
          let rec lock_w_ignore_sig () =
            try Unix.lockf fd (unix_lock_op ~dontblock:false flag) 0;
-           with Sys.Break as e -> (OpamConsole.errmsg "\n"; raise e)
+           with Sys.Break as e -> OpamStd.Exn.finalise e (fun () -> OpamConsole.errmsg "\n")
               | Unix.Unix_error (Unix.EINTR,_,_) -> lock_w_ignore_sig ()
          in lock_w_ignore_sig ();
          OpamConsole.errmsg "lock acquired.\n");

src/format/opamFormat.ml

@@ -728,10 +728,10 @@ module I = struct
                                   "name" dict) then None else
                         match OpamStd.List.assoc String.equal "name" dict with
                         | `String s -> Some s
-                        | _ -> raise Not_found
+                        | _ -> raise_notrace Not_found
                       in Some (s, o)
                     end
-                  | _ -> raise Not_found
+                  | _ -> raise_notrace Not_found
                 with Not_found -> None
               end
             | _ -> None

src/repository/opamDarcs.ml

@@ -128,7 +128,7 @@ module VCS = struct
     | false ->
       let patch_file = OpamSystem.temp_file ~auto_clean: false "darcs-diff" in
       let finalise () = OpamSystem.remove_file patch_file in
-      OpamProcess.Job.catch (fun e -> finalise (); raise e) @@ fun () ->
+      OpamProcess.Job.catch (fun e -> OpamStd.Exn.finalise e finalise) @@ fun () ->
       darcs repo_root ~stdout:patch_file
         [ "diff";
           "--from-tag"; opam_remote_tag; "--to-tag"; opam_local_tag;

src/repository/opamDownload.ml

@@ -201,14 +201,14 @@ let really_download
   OpamProcess.Job.catch
     (function
       | Failure s as e ->
+        OpamStd.Exn.finalise e @@ fun () ->
         OpamSystem.remove tmp_dst;
         if not quiet then OpamConsole.error "%s" s;
-        raise e
       | e ->
+        OpamStd.Exn.finalise e @@ fun () ->
         OpamSystem.remove tmp_dst;
         OpamStd.Exn.fatal e;
-        log "Could not download file at %s." (OpamUrl.to_string url);
-        raise e)
+        log "Could not download file at %s." (OpamUrl.to_string url))
   @@ fun () ->
   download_command ~compress ?checksum ~url ~dst:tmp_dst ()
   @@+ fun () ->