diff options
Diffstat (limited to 'debugger')
| -rw-r--r-- | debugger/command_line.ml | 21 | ||||
| -rw-r--r-- | debugger/debugger_config.ml | 4 | ||||
| -rw-r--r-- | debugger/debugger_config.mli | 4 | ||||
| -rw-r--r-- | debugger/main.ml | 4 | ||||
| -rw-r--r-- | debugger/parser.mly | 2 | ||||
| -rw-r--r-- | debugger/program_loading.ml | 41 |
6 files changed, 72 insertions, 4 deletions
diff --git a/debugger/command_line.ml b/debugger/command_line.ml index 3f84ea7b2..9b0084daf 100644 --- a/debugger/command_line.ml +++ b/debugger/command_line.ml @@ -230,6 +230,22 @@ let instr_shell ppf lexbuf = if (err != 0) then eprintf "Shell command %S failed with exit code %d\n%!" cmd err +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%!" + else + List.iter + (printf "%s\n%!") + (List.rev !Debugger_config.environment) + let instr_pwd ppf lexbuf = eol lexbuf; fprintf ppf "%s@." (Sys.getcwd ()) @@ -454,7 +470,7 @@ let instr_help ppf lexbuf = fprintf ppf "Ambiguous command \"%s\" : %a@." x pr_instrs l end | None -> - fprintf ppf "List of commands :%a@." pr_instrs !instruction_list + fprintf ppf "List of commands : %a@." pr_instrs !instruction_list (* Printing values *) @@ -962,6 +978,9 @@ With no argument, reset the search path." }; { instr_name = "shell"; instr_prio = false; instr_action = instr_shell; instr_repeat = true; instr_help = "Execute a given COMMAND thru the system shell." }; + { instr_name = "environment"; instr_prio = false; + instr_action = instr_env; instr_repeat = false; instr_help = +"environment variable to give to program being debugged when it is started." }; (* Displacements *) { instr_name = "run"; instr_prio = true; instr_action = instr_run; instr_repeat = true; instr_help = diff --git a/debugger/debugger_config.ml b/debugger/debugger_config.ml index 007a3e973..292875936 100644 --- a/debugger/debugger_config.ml +++ b/debugger/debugger_config.ml @@ -80,3 +80,7 @@ let make_checkpoints = ref (match Sys.os_type with "Win32" -> false | _ -> true) + +(*** Environment variables for debugee. ***) + +let environment = ref [] diff --git a/debugger/debugger_config.mli b/debugger/debugger_config.mli index 64411f96a..d3f1a2a7d 100644 --- a/debugger/debugger_config.mli +++ b/debugger/debugger_config.mli @@ -33,3 +33,7 @@ val checkpoint_big_step : int64 ref val checkpoint_small_step : int64 ref val checkpoint_max_count : int ref val make_checkpoints : bool ref + +(*** Environment variables for debugee. ***) + +val environment : string list ref diff --git a/debugger/main.ml b/debugger/main.ml index 5e80081f0..9dbb41ee6 100644 --- a/debugger/main.ml +++ b/debugger/main.ml @@ -183,7 +183,11 @@ let speclist = [ " Print version number and exit"; ] +let function_placeholder () = + raise Not_found + let main () = + Callback.register "Debugger.function_placeholder" function_placeholder; try socket_name := (match Sys.os_type with diff --git a/debugger/parser.mly b/debugger/parser.mly index ae1b0d153..5bba611b9 100644 --- a/debugger/parser.mly +++ b/debugger/parser.mly @@ -170,6 +170,8 @@ longident : LIDENT { Lident $1 } | module_path DOT LIDENT { Ldot($1, $3) } | OPERATOR { Lident $1 } + | module_path DOT OPERATOR { Ldot($1, $3) } + | module_path DOT LPAREN OPERATOR RPAREN { Ldot($1, $4) } ; module_path : diff --git a/debugger/program_loading.ml b/debugger/program_loading.ml index 3f32cb245..6ef9d03e7 100644 --- a/debugger/program_loading.ml +++ b/debugger/program_loading.ml @@ -35,6 +35,39 @@ 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 *) +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 + (* A generic function for launching the program *) let generic_exec_unix cmdline = function () -> if !debug_loading then @@ -52,7 +85,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; - execv shell [| shell; "-c"; cmdline() |] + execve shell [| shell; "-c"; cmdline() |] (get_environment ()) | _ -> exit 0 with x -> Unix_tools.report_error x; @@ -86,7 +119,8 @@ let exec_with_runtime = 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 "set 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 @@ -105,7 +139,8 @@ let exec_direct = match Sys.os_type with "Win32" -> (* See the comment above *) - Printf.sprintf "set CAML_DEBUG_SOCKET=%s && %s %s" + Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s && %s %s" + (get_win32_environment ()) !socket_name !program_name !arguments |