ocamldebug: add a few commandline options

This commit adds the following options to ocamldebug:
 * -no-prompt: suppress all prompts
 * -no-version: do not print version at startup
 * -no-time: do not print times
 * -no-breakpoint: do not print message at breakpoint setup and removal
 * -topdirs-path: set path to the directory containing topdirs.cmi

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

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 \

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 ->

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;

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 =

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

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. *)

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()

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

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. *)