diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index 301dc9aa4a7..40c3b80e8cd 100644 --- a/src/client/opamCommands.ml +++ b/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 "/%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 = diff --git a/src/client/opamConfigCommand.ml b/src/client/opamConfigCommand.ml index 0c4b0593f24..cab33ea46d4 100644 --- a/src/client/opamConfigCommand.ml +++ b/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 diff --git a/src/client/opamListCommand.ml b/src/client/opamListCommand.ml index 917d932d5af..865e1758eda 100644 --- a/src/client/opamListCommand.ml +++ b/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) diff --git a/src/client/opamSolution.ml b/src/client/opamSolution.ml index 0839caa1570..bd88c1cf765 100644 --- a/src/client/opamSolution.ml +++ b/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 diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml index 4fba4086f19..0cc1de62dc2 100644 --- a/src/client/opamSwitchCommand.ml +++ b/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 diff --git a/src/core/opamConsole.ml b/src/core/opamConsole.ml index bd417d86d42..2e05d1d9d72 100644 --- a/src/core/opamConsole.ml +++ b/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 diff --git a/src/core/opamDirTrack.ml b/src/core/opamDirTrack.ml index d57f87385e9..d12758c3091 100644 --- a/src/core/opamDirTrack.ml +++ b/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); diff --git a/src/core/opamFilename.ml b/src/core/opamFilename.ml index b6875032258..79f8044e0a2 100644 --- a/src/core/opamFilename.ml +++ b/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 diff --git a/src/core/opamJson.ml b/src/core/opamJson.ml index a8d1cbe2a0d..93e251bb4cc 100644 --- a/src/core/opamJson.ml +++ b/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 diff --git a/src/core/opamParallel.ml b/src/core/opamParallel.ml index 4754092642a..948e2453d9c 100644 --- a/src/core/opamParallel.ml +++ b/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) diff --git a/src/core/opamProcess.ml b/src/core/opamProcess.ml index b976f81c9ee..da7687177ba 100644 --- a/src/core/opamProcess.ml +++ b/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,7 +429,7 @@ 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 @@ -437,7 +437,7 @@ let create ?info_file ?env_file ?(allow_stdin=not Sys.win32) ?stdout_file ?stder 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 diff --git a/src/core/opamStd.ml b/src/core/opamStd.ml index b5ea475ddb3..82cf1074f24 100644 --- a/src/core/opamStd.ml +++ b/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 diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index 36f9881ef50..d0cce19907b 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -750,7 +750,7 @@ 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 @@ -758,7 +758,7 @@ let classify_executable file = (* 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"); diff --git a/src/format/opamFormat.ml b/src/format/opamFormat.ml index c1471e69109..789682fa5bd 100644 --- a/src/format/opamFormat.ml +++ b/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 diff --git a/src/repository/opamDarcs.ml b/src/repository/opamDarcs.ml index d3b5e5d1079..01d1ff61236 100644 --- a/src/repository/opamDarcs.ml +++ b/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; diff --git a/src/repository/opamDownload.ml b/src/repository/opamDownload.ml index ce5a103e89c..eb2ec7e770e 100644 --- a/src/repository/opamDownload.ml +++ b/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 () -> diff --git a/src/repository/opamGit.ml b/src/repository/opamGit.ml index d2162d58a7e..9f086ae517a 100644 --- a/src/repository/opamGit.ml +++ b/src/repository/opamGit.ml @@ -201,7 +201,7 @@ module VCS : OpamVCS.VCS = struct let rref = remote_ref repo_url in let patch_file = OpamSystem.temp_file ~auto_clean: false "git-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 () -> git repo_root [ "add"; "." ] @@> fun r -> (* Git diff is to the working dir, but doesn't work properly for unregistered directories. *) diff --git a/src/repository/opamHg.ml b/src/repository/opamHg.ml index 014006eb4fb..1b34a23c5c8 100644 --- a/src/repository/opamHg.ml +++ b/src/repository/opamHg.ml @@ -72,7 +72,7 @@ module VCS = struct let diff repo_root repo_url = let patch_file = OpamSystem.temp_file ~auto_clean:false "hg-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 () -> let mark = mark_from_url repo_url in hg repo_root ~stdout:patch_file [ "diff"; "--text"; "--subrepos"; "--reverse"; "--rev"; mark ] @@> fun r -> diff --git a/src/repository/opamRepository.ml b/src/repository/opamRepository.ml index 282159eed6e..7502025ac41 100644 --- a/src/repository/opamRepository.ml +++ b/src/repository/opamRepository.ml @@ -106,7 +106,7 @@ let fetch_from_cache = else (hit, f :: misses)) (None, []) checksums with - | None, _ -> raise Not_found + | None, _ -> raise_notrace Not_found | Some hit_file, miss_files -> if List.for_all (fun ck -> OpamHash.check_file (OpamFilename.to_string hit_file) ck) @@ -573,8 +573,8 @@ let update repo repo_root = Done `No_changes | (Update_full _ | Update_patch _) as upd -> OpamProcess.Job.catch (fun exn -> - cleanup_repo_update upd; - raise exn) + OpamStd.Exn.finalise exn @@ fun () -> + cleanup_repo_update upd) @@ fun () -> validate_repo_update repo repo_root upd @@+ function | false -> diff --git a/src/repository/opamRepositoryRoot.ml b/src/repository/opamRepositoryRoot.ml index 6f4a546f1dd..74bf1ffb0d8 100644 --- a/src/repository/opamRepositoryRoot.ml +++ b/src/repository/opamRepositoryRoot.ml @@ -94,7 +94,7 @@ module Tgz = struct if exists t then let empty = try - fold (fun _ _ _ -> raise Exit) true t + fold (fun _ _ _ -> raise_notrace Exit) true t with Exit -> false in Some empty @@ -227,7 +227,7 @@ let delayed_read_repo = function try Tgz.fold (fun () fname content -> if OpamFilename.Unix.equal fname repo then - raise (Found content)) + raise_notrace (Found content)) () (Tgz.to_file tgz); None with Found content -> Some content diff --git a/src/repository/opamVCS.ml b/src/repository/opamVCS.ml index 03b85f3cfcd..0a6d7b90b6c 100644 --- a/src/repository/opamVCS.ml +++ b/src/repository/opamVCS.ml @@ -76,7 +76,7 @@ module Make (VCS: VCS) = struct let tmpdir = OpamRepositoryRoot.Dir.quarantine repo_root in OpamRepositoryRoot.Dir.copy ~src:repo_root ~dst:tmpdir; OpamProcess.Job.catch - (fun e -> OpamRepositoryRoot.Dir.remove tmpdir; raise e) + (fun e -> OpamStd.Exn.finalise e (fun () -> OpamRepositoryRoot.Dir.remove tmpdir)) @@ fun () -> VCS.reset_tree (OpamRepositoryRoot.Dir.to_dir tmpdir) repo_url @@| fun () -> diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml index e0a0237d6e8..4c1875eaac2 100644 --- a/src/solver/opamCudf.ml +++ b/src/solver/opamCudf.ml @@ -124,7 +124,7 @@ module Json = struct | `A jsons -> begin try let get = function - | None -> raise Not_found + | None -> raise_notrace Not_found | Some v -> v in Some (List.map (fun json -> get (elem_of_json json)) jsons) diff --git a/src/state/opamEnv.ml b/src/state/opamEnv.ml index 42bb8cd0ba6..bf2ac86f925 100644 --- a/src/state/opamEnv.ml +++ b/src/state/opamEnv.ml @@ -1233,7 +1233,7 @@ let write_dynamic_init_scripts st = try if OpamStateConfig.is_newer_than_self ~lock_kind:`Lock_write st.switch_global then - raise OpamSystem.Locked; + raise_notrace OpamSystem.Locked; OpamFilename.with_flock_upgrade `Lock_write ~dontblock:true st.switch_global.global_lock @@ fun _ -> diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml index 8f240152946..e5b54f774c0 100644 --- a/src/state/opamFileTools.ml +++ b/src/state/opamFileTools.ml @@ -321,7 +321,7 @@ let template nv = with | [name], [email] -> Some [Printf.sprintf "%s <%s>" name email] - | _ -> raise Not_found + | _ -> raise_notrace Not_found with e -> OpamStd.Exn.fatal e; None in match from_git with @@ -1252,7 +1252,7 @@ let lint_file ?check_extra_files ?check_upstream ?handle_dirname filename = try let f = OpamFile.Syntax.of_channel filename ic in close_in ic; f - with e -> close_in ic; raise e + with e -> OpamStd.Exn.finalise e (fun () -> close_in ic) with OpamSystem.File_not_found _ -> OpamConsole.error_and_exit `Bad_arguments "File %s not found" (OpamFile.to_string filename) diff --git a/src/state/opamFormatUpgrade.ml b/src/state/opamFormatUpgrade.ml index 094ece678e0..0ecbc75de71 100644 --- a/src/state/opamFormatUpgrade.ml +++ b/src/state/opamFormatUpgrade.ml @@ -54,7 +54,7 @@ let upgrade_depexts_to_2_0_beta5 filename depexts = function | FAnd (f1, f2) -> FAnd (transform_filter f1, transform_filter f2) | FString s -> transform_tag s - | _ -> raise Exit (* the filter is already in the new format if it + | _ -> raise_notrace Exit (* the filter is already in the new format if it contains anything else *) in List.filter_map @@ -393,7 +393,7 @@ let from_1_1_to_1_2 ~on_the_fly:_ root config = OpamPackage.Name.to_string name // "opam") in match OpamFile.OPAM.version_opt (OpamFile.OPAM.read f) with - | None -> raise Not_found + | None -> raise_notrace Not_found | Some v -> v with e -> OpamStd.Exn.fatal e; @@ -734,7 +734,7 @@ let from_1_3_dev6_to_1_3_dev7 ~on_the_fly:_ root conf = Option.iter (fun src -> OpamFilename.copy_dir ~src ~dst:(dstdir / "files")) (OpamFilename.opt_dir (srcdir / "files")) - | None -> raise Not_found + | None -> raise_notrace Not_found with Not_found -> OpamFile.OPAM.write (OpamFile.make (dstdir // "opam")) (OpamFile.OPAM.create nv) @@ -1199,7 +1199,7 @@ let cond_hard_upg_2_6_alpha root _conf = String.equal (OpamFilename.Unix.to_string rfile) OpamRepositoryPathName.repo_f in - raise (Found (is_package || is_repo))) + raise_notrace (Found (is_package || is_repo))) () tgz; false with Found is_repo_or_package_dir -> not is_repo_or_package_dir)) diff --git a/src/state/opamGlobalState.ml b/src/state/opamGlobalState.ml index 0d0b0b459d7..aa194e1bb5e 100644 --- a/src/state/opamGlobalState.ml +++ b/src/state/opamGlobalState.ml @@ -22,8 +22,8 @@ let load_config lock_kind global_lock root = match OpamStateConfig.load ~lock_kind root with | Some c -> c | exception (OpamPp.Bad_version _ as e) -> + OpamStd.Exn.finalise e @@ fun () -> OpamFormatUpgrade.hard_upgrade_from_2_1_intermediates ~global_lock root; - raise e | None -> if OpamFilename.exists (root // "aliases") then OpamFile.Config.(with_opam_version (OpamVersion.of_string "1.1") empty) @@ -75,8 +75,8 @@ let load lock_kind = let config, global_state_to_upgrade = try load_config lock_kind global_lock root with OpamFormatUpgrade.Upgrade_done _ as e -> + OpamStd.Exn.finalise e @@ fun () -> OpamSystem.funlock config_lock; - raise e in if OpamStateConfig.is_newer config && lock_kind <> `Lock_write then log "root version (%s) is greater than running binary's (%s); \ diff --git a/src/state/opamPackageVar.ml b/src/state/opamPackageVar.ml index db69049d588..bb5fe597ac5 100644 --- a/src/state/opamPackageVar.ml +++ b/src/state/opamPackageVar.ml @@ -183,7 +183,7 @@ let build_id st opam = match OpamFile.OPAM.url opam with | Some urlf when OpamFile.URL.checksum urlf = [] -> (* no fixed source: build-id undefined *) - raise Exit + raise_notrace Exit | _ -> let hash_map, deps_hashes = OpamPackage.Set.fold (fun nv (hash_map, hashes) -> @@ -234,7 +234,7 @@ let resolve st ?opam:opam_arg ?(local=OpamVariable.Map.empty) v = | None -> let var = OpamVariable.Full.variable v in try match OpamVariable.Map.find var local with - | None -> raise Exit (* Variable explicitly undefined *) + | None -> raise_notrace Exit (* Variable explicitly undefined *) | some -> some with Not_found -> None in @@ -246,7 +246,7 @@ let resolve st ?opam:opam_arg ?(local=OpamVariable.Map.empty) v = | OpamVariable.Full.Global -> assert false | OpamVariable.Full.Package n -> n | OpamVariable.Full.Self -> - match pkgname with Some n -> n | None -> raise Exit + match pkgname with Some n -> n | None -> raise_notrace Exit in let opam = (* ensure opam, if not None, corresponds to name *) match opam_arg with diff --git a/src/state/opamRepositoryState.ml b/src/state/opamRepositoryState.ml index 9327ef90499..765aa0640e6 100644 --- a/src/state/opamRepositoryState.ml +++ b/src/state/opamRepositoryState.ml @@ -207,7 +207,7 @@ let load_raw_opams_and_aux_from_tgz _repo_name tgz = try OpamFilename.Unix.Dir.Map.iter (fun dir value -> if OpamFilename.Unix.starts_with dir filename then - raise (Found (dir, value))) acc; + raise_notrace (Found (dir, value))) acc; acc with Found (key, value) -> let fo, co, map = value in diff --git a/src/state/opamStateConfig.ml b/src/state/opamStateConfig.ml index aaa19fe8881..1889b732053 100644 --- a/src/state/opamStateConfig.ml +++ b/src/state/opamStateConfig.ml @@ -380,11 +380,12 @@ let local_switch_exists root switch = | None -> false | Some conf -> conf.OpamFile.Switch_config.opam_root = Some root | exception (OpamPp.Bad_version _ as e) -> + let bt = Printexc.get_raw_backtrace () in match OpamFile.Config.raw_root_version (OpamPath.config root) with - | None -> raise e + | None -> Printexc.raise_with_backtrace e bt | Some _ -> match downgrade_2_1_switch f with - | None -> raise e + | None -> Printexc.raise_with_backtrace e bt | Some conf -> if conf.OpamFile.Switch_config.opam_root = Some root then (OpamFile.Switch_config.write f conf; true) diff --git a/src/state/opamSwitchAction.ml b/src/state/opamSwitchAction.ml index 4de422f6eab..911d26818aa 100644 --- a/src/state/opamSwitchAction.ml +++ b/src/state/opamSwitchAction.ml @@ -86,9 +86,9 @@ let create_empty_switch gt ?synopsis ?repos ?invariant switch = OpamGlobalState.write gt; gt with e -> + OpamStd.Exn.finalise e @@ fun () -> if not (OpamConsole.debug ()) then - OpamFilename.rmdir switch_dir; - raise e + OpamFilename.rmdir switch_dir let write_selections st = if not OpamStateConfig.(!r.dryrun) then diff --git a/src/state/opamSwitchState.ml b/src/state/opamSwitchState.ml index 022c98b338c..973d3929f5f 100644 --- a/src/state/opamSwitchState.ml +++ b/src/state/opamSwitchState.ml @@ -25,9 +25,9 @@ let load_switch_config ~lock_kind gt switch = 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 ~global_lock:gt.global_lock gt.root; - raise e | None -> (OpamConsole.error "No config file found for switch %s. Switch broken?"