diff --git a/Changes b/Changes index 532f4305e..7e1b7e744 100644 --- a/Changes +++ b/Changes @@ -225,6 +225,10 @@ Working version - MPR#7687: deprecate -thread option, which is equivalent to -I +threads. (Nicolás Ojeda Bär, report by Daniel Bünzli) +- GPR#1667: add command-line options -no-propt, -no-version, -no-time, + -no-breakpoint and -topdirs-path to ocamldebug + (Sébastien Hinderer, review by Damien Doligez) + ### Manual and documentation: - PR#7647, GPR#1384: emphasize ocaml.org website and forum in README diff --git a/debugger/.depend b/debugger/.depend index 86b18ab61..5e1310c45 100644 --- a/debugger/.depend +++ b/debugger/.depend @@ -1,7 +1,9 @@ -breakpoints.cmo : symbols.cmi pos.cmi ../bytecomp/instruct.cmi exec.cmi \ - debugcom.cmi checkpoints.cmi breakpoints.cmi -breakpoints.cmx : symbols.cmx pos.cmx ../bytecomp/instruct.cmx exec.cmx \ - debugcom.cmx checkpoints.cmx breakpoints.cmi +breakpoints.cmo : symbols.cmi pos.cmi parameters.cmi \ + ../bytecomp/instruct.cmi exec.cmi debugcom.cmi checkpoints.cmi \ + breakpoints.cmi +breakpoints.cmx : symbols.cmx pos.cmx parameters.cmx \ + ../bytecomp/instruct.cmx exec.cmx debugcom.cmx checkpoints.cmx \ + breakpoints.cmi breakpoints.cmi : ../bytecomp/instruct.cmi checkpoints.cmo : primitives.cmi int64ops.cmi debugcom.cmi checkpoints.cmi checkpoints.cmx : primitives.cmx int64ops.cmx debugcom.cmx checkpoints.cmi @@ -67,9 +69,9 @@ history.cmx : primitives.cmx int64ops.cmx debugger_config.cmx \ checkpoints.cmx history.cmi history.cmi : input_handling.cmo : $(UNIXDIR)/unix.cmi primitives.cmi \ - input_handling.cmi + parameters.cmi input_handling.cmi input_handling.cmx : $(UNIXDIR)/unix.cmx primitives.cmx \ - input_handling.cmi + parameters.cmx input_handling.cmi input_handling.cmi : primitives.cmi int64ops.cmo : int64ops.cmi int64ops.cmx : int64ops.cmi @@ -78,28 +80,28 @@ lexer.cmo : parser.cmi lexer.cmi lexer.cmx : parser.cmx lexer.cmi lexer.cmi : parser.cmi loadprinter.cmo : ../typing/types.cmi ../bytecomp/symtable.cmi printval.cmi \ - ../typing/printtyp.cmi ../typing/path.cmi ../utils/misc.cmi \ - ../parsing/longident.cmi ../parsing/location.cmi ../typing/ident.cmi \ - ../typing/env.cmi ../typing/ctype.cmi ../utils/config.cmi \ - ../driver/compdynlink.cmi loadprinter.cmi + ../typing/printtyp.cmi ../typing/path.cmi parameters.cmi \ + ../utils/misc.cmi ../parsing/longident.cmi ../parsing/location.cmi \ + ../typing/ident.cmi ../typing/env.cmi ../typing/ctype.cmi \ + ../utils/config.cmi ../driver/compdynlink.cmi loadprinter.cmi loadprinter.cmx : ../typing/types.cmx ../bytecomp/symtable.cmx printval.cmx \ - ../typing/printtyp.cmx ../typing/path.cmx ../utils/misc.cmx \ - ../parsing/longident.cmx ../parsing/location.cmx ../typing/ident.cmx \ - ../typing/env.cmx ../typing/ctype.cmx ../utils/config.cmx \ - ../driver/compdynlink.cmi loadprinter.cmi + ../typing/printtyp.cmx ../typing/path.cmx parameters.cmx \ + ../utils/misc.cmx ../parsing/longident.cmx ../parsing/location.cmx \ + ../typing/ident.cmx ../typing/env.cmx ../typing/ctype.cmx \ + ../utils/config.cmx ../driver/compdynlink.cmi loadprinter.cmi loadprinter.cmi : ../parsing/longident.cmi ../driver/compdynlink.cmi main.cmo : unix_tools.cmi $(UNIXDIR)/unix.cmi time_travel.cmi \ show_information.cmi question.cmi program_management.cmi primitives.cmi \ - parameters.cmi ../utils/misc.cmi input_handling.cmi frames.cmi exec.cmi \ - ../typing/env.cmi debugger_config.cmi ../utils/config.cmi \ - command_line.cmi ../typing/cmi_format.cmi ../utils/clflags.cmi \ - checkpoints.cmi + parameters.cmi ../utils/misc.cmi loadprinter.cmi input_handling.cmi \ + frames.cmi exec.cmi ../typing/env.cmi debugger_config.cmi \ + ../utils/config.cmi command_line.cmi ../typing/cmi_format.cmi \ + ../utils/clflags.cmi checkpoints.cmi main.cmx : unix_tools.cmx $(UNIXDIR)/unix.cmx time_travel.cmx \ show_information.cmx question.cmx program_management.cmx primitives.cmx \ - parameters.cmx ../utils/misc.cmx input_handling.cmx frames.cmx exec.cmx \ - ../typing/env.cmx debugger_config.cmx ../utils/config.cmx \ - command_line.cmx ../typing/cmi_format.cmx ../utils/clflags.cmx \ - checkpoints.cmx + parameters.cmx ../utils/misc.cmx loadprinter.cmx input_handling.cmx \ + frames.cmx exec.cmx ../typing/env.cmx debugger_config.cmx \ + ../utils/config.cmx command_line.cmx ../typing/cmi_format.cmx \ + ../utils/clflags.cmx checkpoints.cmx parameters.cmo : primitives.cmi ../typing/envaux.cmi debugger_config.cmi \ ../utils/config.cmi parameters.cmi parameters.cmx : primitives.cmx ../typing/envaux.cmx debugger_config.cmx \ diff --git a/debugger/breakpoints.ml b/debugger/breakpoints.ml index 5d5b6cedd..62e8ecfb8 100644 --- a/debugger/breakpoints.ml +++ b/debugger/breakpoints.ml @@ -170,9 +170,11 @@ let rec new_breakpoint = incr breakpoint_number; insert_position event.ev_pos; breakpoints := (!breakpoint_number, event) :: !breakpoints); - printf "Breakpoint %d at %d: %s" !breakpoint_number event.ev_pos - (Pos.get_desc event); - print_newline () + if !Parameters.breakpoint then begin + printf "Breakpoint %d at %d: %s" !breakpoint_number event.ev_pos + (Pos.get_desc event); + print_newline () + end (* Remove a breakpoint from lists. *) let remove_breakpoint number = @@ -183,9 +185,11 @@ let remove_breakpoint number = (function () -> breakpoints := List.remove_assoc number !breakpoints; remove_position pos; - printf "Removed breakpoint %d at %d: %s" number ev.ev_pos - (Pos.get_desc ev); - print_newline () + if !Parameters.breakpoint then begin + printf "Removed breakpoint %d at %d: %s" number ev.ev_pos + (Pos.get_desc ev); + print_newline () + end ) with Not_found -> diff --git a/debugger/input_handling.ml b/debugger/input_handling.ml index 91f4cc502..e69c5f4b9 100644 --- a/debugger/input_handling.ml +++ b/debugger/input_handling.ml @@ -108,7 +108,7 @@ let stop_user_input () = (* Resume reading user input. *) let resume_user_input () = if not (List.mem_assoc !user_channel.io_fd !active_files) then begin - if !interactif then begin + if !interactif && !Parameters.prompt then begin print_string !current_prompt; flush Pervasives.stdout end; diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml index 9ab0d6809..b657331b3 100644 --- a/debugger/loadprinter.ml +++ b/debugger/loadprinter.ml @@ -106,11 +106,9 @@ let eval_path path = (* since 4.00, "topdirs.cmi" is not in the same directory as the standard library, so we load it beforehand as it cannot be found in the search path. *) -let () = - let compiler_libs = - Filename.concat Config.standard_library "compiler-libs" in +let init () = let topdirs = - Filename.concat compiler_libs "topdirs.cmi" in + Filename.concat !Parameters.topdirs_path "topdirs.cmi" in ignore (Env.read_signature "Topdirs" topdirs) let match_printer_type desc typename = diff --git a/debugger/loadprinter.mli b/debugger/loadprinter.mli index c645e8d21..81e4814e7 100644 --- a/debugger/loadprinter.mli +++ b/debugger/loadprinter.mli @@ -17,6 +17,8 @@ open Format +val init : unit -> unit + val loadfile : formatter -> string -> unit val install_printer : formatter -> Longident.t -> unit val remove_printer : Longident.t -> unit diff --git a/debugger/main.ml b/debugger/main.ml index 4f2b830f4..870275963 100644 --- a/debugger/main.ml +++ b/debugger/main.ml @@ -152,6 +152,8 @@ let add_include d = Misc.expand_directory Config.standard_library d :: !default_load_path let set_socket s = socket_name := s +let set_topdirs_path s = + topdirs_path := s let set_checkpoints n = checkpoint_max_count := n let set_directory dir = @@ -182,6 +184,16 @@ let speclist = [ " Print version and exit"; "-vnum", Arg.Unit print_version_num, " Print version number and exit"; + "-no-version", Arg.Clear Parameters.version, + " Do not print version at startup"; + "-no-prompt", Arg.Clear Parameters.prompt, + " Suppress all prompts"; + "-no-time", Arg.Clear Parameters.time, + " Do not print times"; + "-no-breakpoint-message", Arg.Clear Parameters.breakpoint, + " Do not print message at breakpoint setup and removal"; + "-topdirs-path", Arg.String set_topdirs_path, + " Set path to the directory containing topdirs.cmi"; ] let function_placeholder () = @@ -211,7 +223,9 @@ let main () = arguments := !arguments ^ " " ^ (Filename.quote Sys.argv.(j)) done end; - printf "\tOCaml Debugger version %s@.@." Config.version; + if !Parameters.version + then printf "\tOCaml Debugger version %s@.@." Config.version; + Loadprinter.init(); Config.load_path := !default_load_path; Clflags.recursive_types := true; (* Allow recursive types. *) toplevel_loop (); (* Toplevel. *) diff --git a/debugger/parameters.ml b/debugger/parameters.ml index a4d647c49..ea11698a0 100644 --- a/debugger/parameters.ml +++ b/debugger/parameters.ml @@ -27,6 +27,13 @@ let arguments = ref "" let default_load_path = ref [ Filename.current_dir_name; Config.standard_library ] +let breakpoint = ref true +let prompt = ref true +let time = ref true +let version = ref true + +let topdirs_path = ref (Filename.concat Config.standard_library "compiler-libs") + let add_path dir = load_path := dir :: except dir !load_path; Envaux.reset_cache() diff --git a/debugger/parameters.mli b/debugger/parameters.mli index 388fb94d8..d680e7f19 100644 --- a/debugger/parameters.mli +++ b/debugger/parameters.mli @@ -20,6 +20,11 @@ val program_name : string ref val socket_name : string ref val arguments : string ref val default_load_path : string list ref +val breakpoint : bool ref +val prompt : bool ref +val time : bool ref +val version : bool ref +val topdirs_path : string ref val add_path : string -> unit val add_path_for : string -> string -> unit diff --git a/debugger/show_information.ml b/debugger/show_information.ml index 30d7774e2..29fe1fb69 100644 --- a/debugger/show_information.ml +++ b/debugger/show_information.ml @@ -28,20 +28,23 @@ open Parameters (* Display information about the current event. *) let show_current_event ppf = - fprintf ppf "Time: %Li" (current_time ()); - (match current_pc () with - | Some pc -> - fprintf ppf " - pc: %i" pc - | _ -> ()); + if !Parameters.time then begin + fprintf ppf "Time: %Li" (current_time ()); + (match current_pc () with + | Some pc -> + fprintf ppf " - pc: %i" pc + | _ -> ()); + end; update_current_event (); reset_frame (); match current_report () with | None -> - fprintf ppf "@.Beginning of program.@."; + if !Parameters.time then fprintf ppf "@."; + fprintf ppf "Beginning of program.@."; show_no_point () | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} -> let ev = get_current_event () in - fprintf ppf " - module %s@." ev.ev_module; + if !Parameters.time then fprintf ppf " - module %s@." ev.ev_module; (match breakpoints_at_pc pc with | [] -> () @@ -55,17 +58,20 @@ let show_current_event ppf = (List.sort compare breakpoints)); show_point ev true | Some {rep_type = Exited} -> - fprintf ppf "@.Program exit.@."; + if !Parameters.time then fprintf ppf "@."; + fprintf ppf "Program exit.@."; show_no_point () | Some {rep_type = Uncaught_exc} -> + if !Parameters.time then fprintf ppf "@."; fprintf ppf - "@.Program end.@.\ + "Program end.@.\ @[Uncaught exception:@ %a@]@." Printval.print_exception (Debugcom.Remote_value.accu ()); show_no_point () | Some {rep_type = Trap_barrier} -> (* Trap_barrier not visible outside *) (* of module `time_travel'. *) + if !Parameters.time then fprintf ppf "@."; Misc.fatal_error "Show_information.show_current_event" (* Display short information about one frame. *)