diff options
| -rw-r--r-- | debugger/command_line.ml | 22 | ||||
| -rw-r--r-- | debugger/debugger_config.mli | 2 | ||||
| -rw-r--r-- | debugger/main.ml | 5 | ||||
| -rw-r--r-- | debugger/program_loading.ml | 57 |
4 files changed, 36 insertions, 50 deletions
diff --git a/debugger/command_line.ml b/debugger/command_line.ml index d10862154..a4647110d 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 f725acecf..ab935d932 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 85bc9afb6..9b4359e95 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) diff --git a/debugger/program_loading.ml b/debugger/program_loading.ml index 99bfe6b47..b2d472a7d 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) |