diff --git a/CHANGELOG.md b/CHANGELOG.md index 29b27a6..7afc5e4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,11 @@ * Fix the empty "Globals" scope on OCaml >= 5.2 (#74). Globals are numbered by `Symtable.Global.t` rather than by `Ident.t` since 5.2, and reading the SYMB section with the old key type left the scope empty. +* Fix a `launch` request being dropped when sent immediately after + `initialize`. The Launch handler was registered one scheduler tick after the + initialize response was sent, so a pipelined `launch` could arrive first, be + silently dropped ("Can not find handler"), and leave the session stuck with no + `initialized` event. ### Added diff --git a/src/adapter/state_uninitialized.ml b/src/adapter/state_uninitialized.ml index 072f983..3360f30 100644 --- a/src/adapter/state_uninitialized.ml +++ b/src/adapter/state_uninitialized.ml @@ -18,6 +18,11 @@ let run rpc = ~supports_breakpoint_locations_request:(Some true) ~supports_value_formatting_options:(Some true) ()) in - Lwt.wakeup_later resolver (arg, caps); + (* Wake immediately so that the next state registers + its Launch/Attach handlers synchronously, before this handler returns + and the initialize response is sent. Otherwise a client that pipelines + "launch" right after "initialize" can have it arrive before the handler + exists, and it is silently dropped. *) + Lwt.wakeup resolver (arg, caps); Lwt.return caps); promise diff --git a/test/dune b/test/dune index 16430da..5aab1a9 100644 --- a/test/dune +++ b/test/dune @@ -17,6 +17,29 @@ (pps lwt_ppx)) (libraries dap.types dap_client lwt lwt.unix)) +; A raw-framing client (does not use dap_client, so it can pipeline requests). +(executable + (name test_launch_race) + (modules test_launch_race) + (preprocess + (pps lwt_ppx)) + (libraries lwt lwt.unix)) + +(rule + (targets test_launch_race.actual) + (deps + (:driver test_launch_race.exe) + (:adapter %{exe:../src/main/main.exe}) + fixtures/hello.bc) + (action + (setenv EARLYBIRD_ADAPTER %{adapter} + (with-stdout-to %{targets} (run %{driver}))))) + +(rule + (alias runtest) + (action + (diff test_launch_race.expected test_launch_race.actual))) + (rule (targets test_scopes.actual) (deps diff --git a/test/test_launch_race.expected b/test/test_launch_race.expected new file mode 100644 index 0000000..fdb053a --- /dev/null +++ b/test/test_launch_race.expected @@ -0,0 +1 @@ +received the initialized event diff --git a/test/test_launch_race.ml b/test/test_launch_race.ml new file mode 100644 index 0000000..d1c4317 --- /dev/null +++ b/test/test_launch_race.ml @@ -0,0 +1,74 @@ +(* Regression test for the initialize/launch handler race. A client that + pipelines "launch" right after "initialize", sending both before reading the + initialize response, must still have its launch handled and receive the + "initialized" event. Before the fix the launch could arrive before the + adapter had registered the Launch handler and was silently dropped, so no + "initialized" event ever came (see the intermittent CI timeout). + + This talks to the adapter with raw framing rather than the Debug_rpc client, + so we can pipeline the two requests. *) + +let adapter = + match Sys.getenv_opt "EARLYBIRD_ADAPTER" with + | Some adapter -> adapter + | None -> failwith "EARLYBIRD_ADAPTER is not set" + +let program = Filename.concat (Sys.getcwd ()) "fixtures/hello.bc" + +let frame seq command arguments = + let body = + Printf.sprintf {|{"seq":%d,"type":"request","command":"%s","arguments":%s}|} + seq command arguments + in + Printf.sprintf "Content-Length: %d\r\n\r\n%s" (String.length body) body + +(* Whether [sub] occurs in [s]. *) +let contains_substring s sub = + let n = String.length s and m = String.length sub in + let rec at i = i + m <= n && (String.sub s i m = sub || at (i + 1)) in + m = 0 || at 0 + +(* Read one DAP message and return its raw JSON body. *) +let read_message ic = + let rec headers content_length = + let%lwt line = Lwt_io.read_line ic in + match String.trim line with + | "" -> Lwt.return content_length + | line -> ( + match String.split_on_char ':' line with + | [ key; value ] when String.trim key = "Content-Length" -> + headers (int_of_string (String.trim value)) + | _ -> headers content_length) + in + let%lwt length = headers 0 in + let buf = Bytes.create length in + Lwt_io.read_into_exactly ic buf 0 length;%lwt + Lwt.return (Bytes.to_string buf) + +let main () = + let proc = Lwt_process.open_process (adapter, [| adapter; "debug" |]) in + let init = frame 1 "initialize" {|{"adapterID":"ocaml"}|} in + let launch = + frame 2 "launch" + (Printf.sprintf + {|{"name":"race","program":%S,"stopOnEntry":false,"console":"internalConsole"}|} + program) + in + Lwt_io.write proc#stdin (init ^ launch);%lwt + Lwt_io.flush proc#stdin;%lwt + let rec wait_initialized () = + let%lwt message = read_message proc#stdout in + if contains_substring message {|"initialized"|} then + Lwt.return "received the initialized event" + else wait_initialized () + in + let timeout = + Lwt_unix.sleep 30.0;%lwt + Lwt.return "timed out waiting for the initialized event" + in + let%lwt result = Lwt.pick [ wait_initialized (); timeout ] in + print_endline result; + proc#terminate; + Lwt.return () + +let () = Lwt_main.run (main ())