summaryrefslogtreecommitdiff
path: root/debugger
diff options
context:
space:
mode:
Diffstat (limited to 'debugger')
-rw-r--r--debugger/.depend10
-rw-r--r--debugger/Makefile.shared6
-rw-r--r--debugger/command_line.ml22
-rw-r--r--debugger/debugger_config.mli2
-rw-r--r--debugger/main.ml11
-rw-r--r--debugger/parameters.ml2
-rw-r--r--debugger/parameters.mli2
-rw-r--r--debugger/printval.ml4
-rw-r--r--debugger/program_loading.ml57
-rw-r--r--debugger/show_information.ml13
10 files changed, 65 insertions, 64 deletions
diff --git a/debugger/.depend b/debugger/.depend
index 60b0baeff6..13de8ede13 100644
--- a/debugger/.depend
+++ b/debugger/.depend
@@ -172,11 +172,13 @@ program_management.cmx : unix_tools.cmx $(UNIXDIR)/unix.cmx \
question.cmo : primitives.cmi lexer.cmi input_handling.cmi question.cmi
question.cmx : primitives.cmx lexer.cmx input_handling.cmx question.cmi
show_information.cmo : symbols.cmi source.cmi show_source.cmi printval.cmi \
- ../utils/misc.cmi ../bytecomp/instruct.cmi frames.cmi events.cmi \
- debugcom.cmi checkpoints.cmi breakpoints.cmi show_information.cmi
+ parameters.cmi ../utils/misc.cmi ../bytecomp/instruct.cmi frames.cmi \
+ events.cmi debugcom.cmi checkpoints.cmi breakpoints.cmi \
+ show_information.cmi
show_information.cmx : symbols.cmx source.cmx show_source.cmx printval.cmx \
- ../utils/misc.cmx ../bytecomp/instruct.cmx frames.cmx events.cmx \
- debugcom.cmx checkpoints.cmx breakpoints.cmx show_information.cmi
+ parameters.cmx ../utils/misc.cmx ../bytecomp/instruct.cmx frames.cmx \
+ events.cmx debugcom.cmx checkpoints.cmx breakpoints.cmx \
+ show_information.cmi
show_source.cmo : source.cmi primitives.cmi parameters.cmi \
../parsing/location.cmi ../bytecomp/instruct.cmi events.cmi \
debugger_config.cmi show_source.cmi
diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared
index 815ab3258b..d85419eb0c 100644
--- a/debugger/Makefile.shared
+++ b/debugger/Makefile.shared
@@ -12,9 +12,9 @@
include ../config/Makefile
-CAMLC=$(CAMLC_BIN) -nostdlib -I ../stdlib
-COMPFLAGS=-g -warn-error A $(INCLUDES)
-LINKFLAGS=-g -linkall -I $(UNIXDIR)
+CAMLC=../ocamlcomp.sh
+COMPFLAGS=-warn-error A $(INCLUDES)
+LINKFLAGS=-linkall -I $(UNIXDIR)
CAMLYACC=../boot/ocamlyacc
YACCFLAGS=
CAMLLEX=../boot/ocamlrun ../boot/ocamllex
diff --git a/debugger/command_line.ml b/debugger/command_line.ml
index d108621545..a4647110d6 100644
--- a/debugger/command_line.ml
+++ b/debugger/command_line.ml
@@ -234,16 +234,22 @@ let instr_env ppf lexbuf =
let cmdarg = argument_list_eol argument lexbuf in
let cmdarg = string_trim (String.concat " " cmdarg) in
if cmdarg <> "" then
- try
- if (String.index cmdarg '=') > 0 then
- Debugger_config.environment := cmdarg :: !Debugger_config.environment
- else
- eprintf "Environment variables should not have an empty name\n%!"
- with Not_found ->
- eprintf "Environment variables should have the \"name=value\" format\n%!"
+ if ask_kill_program () then begin
+ try
+ let eqpos = String.index cmdarg '=' in
+ if eqpos = 0 then raise Not_found;
+ let name = String.sub cmdarg 0 eqpos in
+ let value =
+ String.sub cmdarg (eqpos + 1) (String.length cmdarg - eqpos - 1)
+ in
+ Debugger_config.environment :=
+ (name, value) :: List.remove_assoc name !Debugger_config.environment
+ with Not_found ->
+ eprintf "Environment variable must be in name=value format\n%!"
+ end
else
List.iter
- (printf "%s\n%!")
+ (fun (vvar, vval) -> printf "%s=%s\n%!" vvar vval)
(List.rev !Debugger_config.environment)
let instr_pwd ppf lexbuf =
diff --git a/debugger/debugger_config.mli b/debugger/debugger_config.mli
index f725acecf8..ab935d9324 100644
--- a/debugger/debugger_config.mli
+++ b/debugger/debugger_config.mli
@@ -34,4 +34,4 @@ val make_checkpoints : bool ref
(*** Environment variables for debugee. ***)
-val environment : string list ref
+val environment : (string * string) list ref
diff --git a/debugger/main.ml b/debugger/main.ml
index 85bc9afb6b..52c1ed9952 100644
--- a/debugger/main.ml
+++ b/debugger/main.ml
@@ -26,10 +26,7 @@ open Primitives
let line_buffer = Lexing.from_function read_user_input
-let rec loop ppf =
- line_loop ppf line_buffer;
- if !loaded && (not (yes_or_no "The program is running. Quit anyway")) then
- loop ppf
+let rec loop ppf = line_loop ppf line_buffer
let current_duration = ref (-1L)
@@ -170,10 +167,12 @@ let speclist = [
"<count> Set max number of checkpoints kept";
"-cd", Arg.String set_directory,
"<dir> Change working directory";
- "-emacs", Arg.Set emacs,
- "For running the debugger under emacs";
+ "-emacs", Arg.Tuple [Arg.Set emacs; Arg.Set machine_readable],
+ "For running the debugger under emacs; implies -machine-readable";
"-I", Arg.String add_include,
"<dir> Add <dir> to the list of include directories";
+ "-machine-readable", Arg.Set machine_readable,
+ "Print information in a format more suitable for machines";
"-s", Arg.String set_socket,
"<filename> Set the name of the communication socket";
"-version", Arg.Unit print_version,
diff --git a/debugger/parameters.ml b/debugger/parameters.ml
index 2e1d4a7530..d8c85efe00 100644
--- a/debugger/parameters.ml
+++ b/debugger/parameters.ml
@@ -35,3 +35,5 @@ let add_path_for mdl dir =
(* Used by emacs ? *)
let emacs = ref false
+
+let machine_readable = ref false
diff --git a/debugger/parameters.mli b/debugger/parameters.mli
index 244d24b35f..44c850d5c7 100644
--- a/debugger/parameters.mli
+++ b/debugger/parameters.mli
@@ -23,3 +23,5 @@ val add_path_for : string -> string -> unit
(* Used by emacs ? *)
val emacs : bool ref
+
+val machine_readable : bool ref
diff --git a/debugger/printval.ml b/debugger/printval.ml
index 0fa2eced2d..5170ef3b24 100644
--- a/debugger/printval.ml
+++ b/debugger/printval.ml
@@ -47,7 +47,7 @@ module EvalPath =
struct
type valu = Debugcom.Remote_value.t
exception Error
- let rec eval_path = function
+ let rec eval_path env = function
Pident id ->
begin try
Debugcom.Remote_value.global (Symtable.get_global_position id)
@@ -55,7 +55,7 @@ module EvalPath =
raise Error
end
| Pdot(root, fieldname, pos) ->
- let v = eval_path root in
+ let v = eval_path env root in
if not (Debugcom.Remote_value.is_block v)
then raise Error
else Debugcom.Remote_value.field v pos
diff --git a/debugger/program_loading.ml b/debugger/program_loading.ml
index 99bfe6b478..b2d472a7dc 100644
--- a/debugger/program_loading.ml
+++ b/debugger/program_loading.ml
@@ -33,38 +33,19 @@ let load_program () =
(*** Launching functions. ***)
-(* Returns the environment to be passed to debugee *)
-let get_environment () =
- let env = Unix.environment () in
- let have_same_name x y =
- let split = Primitives.split_string '=' in
- match split x, split y with
- (hd1 :: _), (hd2 :: _) -> hd1 = hd2
- | _ -> false in
- let have_name_in_config_env x =
- List.exists
- (have_same_name x)
- !Debugger_config.environment in
- let env =
- Array.fold_right
- (fun elem acc ->
- if have_name_in_config_env elem then
- acc
- else
- elem :: acc)
- env
- [] in
- Array.of_list (env @ !Debugger_config.environment)
-
-(* Returns the environment to be passed to debugee *)
+(* Returns a command line prefix to set environment for the debuggee *)
+let get_unix_environment () =
+ let f (vname, vvalue) =
+ Printf.sprintf "%s=%s " vname (Filename.quote vvalue)
+ in
+ String.concat "" (List.map f !Debugger_config.environment)
+;;
+
+(* Returns a command line prefix to set environment for the debuggee *)
let get_win32_environment () =
- let res = Buffer.create 256 in
- let env = get_environment () in
- let len = Array.length env in
- for i = 0 to pred len do
- Buffer.add_string res (Printf.sprintf "set %s && " env.(i))
- done;
- Buffer.contents res
+ (* Note: no space before the & or Windows will add it to the value *)
+ let f (vname, vvalue) = Printf.sprintf "set %s=%s&" vname vvalue in
+ String.concat "" (List.map f !Debugger_config.environment)
(* A generic function for launching the program *)
let generic_exec_unix cmdline = function () ->
@@ -83,7 +64,7 @@ let generic_exec_unix cmdline = function () ->
0 -> (* Try to detach the process from the controlling terminal,
so that it does not receive SIGINT on ctrl-C. *)
begin try ignore(setsid()) with Invalid_argument _ -> () end;
- execve shell [| shell; "-c"; cmdline() |] (get_environment ())
+ execv shell [| shell; "-c"; cmdline() |]
| _ -> exit 0
with x ->
Unix_tools.report_error x;
@@ -113,18 +94,19 @@ let exec_with_runtime =
(function () ->
match Sys.os_type with
"Win32" ->
- (* This fould fail on a file name with spaces
+ (* This would fail on a file name with spaces
but quoting is even worse because Unix.create_process
thinks each command line parameter is a file.
So no good solution so far *)
- Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s && %s %s %s"
+ Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s& %s %s %s"
(get_win32_environment ())
!socket_name
runtime_program
!program_name
!arguments
| _ ->
- Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s %s"
+ Printf.sprintf "%sCAML_DEBUG_SOCKET=%s %s %s %s"
+ (get_unix_environment ())
!socket_name
(Filename.quote runtime_program)
(Filename.quote !program_name)
@@ -137,13 +119,14 @@ let exec_direct =
match Sys.os_type with
"Win32" ->
(* See the comment above *)
- Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s && %s %s"
+ Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s& %s %s"
(get_win32_environment ())
!socket_name
!program_name
!arguments
| _ ->
- Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s"
+ Printf.sprintf "%sCAML_DEBUG_SOCKET=%s %s %s"
+ (get_unix_environment ())
!socket_name
(Filename.quote !program_name)
!arguments)
diff --git a/debugger/show_information.ml b/debugger/show_information.ml
index 89111d3cc9..690645dfe2 100644
--- a/debugger/show_information.ml
+++ b/debugger/show_information.ml
@@ -21,6 +21,7 @@ open Frames
open Source
open Show_source
open Breakpoints
+open Parameters
(* Display information about the current event. *)
let show_current_event ppf =
@@ -73,9 +74,15 @@ let show_one_frame framenum ppf event =
let buffer = get_buffer pos event.ev_module in
snd (start_and_cnum buffer pos)
with _ -> pos.Lexing.pos_cnum in
- fprintf ppf "#%i Pc: %i %s char %i@."
- framenum event.ev_pos event.ev_module
- cnum
+ if !machine_readable then
+ fprintf ppf "#%i Pc: %i %s char %i@."
+ framenum event.ev_pos event.ev_module
+ cnum
+ else
+ fprintf ppf "#%i %s %s:%i:%i@."
+ framenum event.ev_module
+ pos.Lexing.pos_fname pos.Lexing.pos_lnum
+ (pos.Lexing.pos_cnum - pos.Lexing.pos_bol + 1)
(* Display information about the current frame. *)
(* --- `select frame' must have succeded before calling this function. *)
View Lorry Controller Status