Restore globals scope for 5.2 and above

.github/workflows/ci.yml

@@ -49,3 +49,6 @@ jobs:
 
       - name: Build
         run: opam exec -- dune build
+
+      - name: Test
+        run: opam exec -- dune runtest

CHANGELOG.md

@@ -1,3 +1,15 @@
+## Unreleased
+
+### Fixed
+
+* 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.
+
+### Added
+
+* Add integration tests driving the adapter over the debug adapter protocol.
+
 ## 1.3.6 - 2026-04-25
 
 ### Added

dune-project

@@ -32,4 +32,4 @@
   (sexplib (>= v0.14.0))
   (csexp (>= 1.3.2))
   (lru (>= 0.3.0))
-  (dap (>= 1.0.6))))
+  (dap (>= 1.1.0))))

earlybird.opam

@@ -26,7 +26,7 @@ depends: [
   "sexplib" {>= "v0.14.0"}
   "csexp" {>= "1.3.2"}
   "lru" {>= "0.3.0"}
-  "dap" {>= "1.0.6"}
+  "dap" {>= "1.1.0"}
   "odoc" {with-doc}
 ]
 build: [

src/adapter/state_initialized.ml

@@ -50,7 +50,8 @@ let spawn_terminal ~kind ~rpc ?name ?env ?cwd prog args =
         Debug_rpc.exec_command rpc
           (module Run_in_terminal_command)
           Run_in_terminal_command.Arguments.
-            { kind = Some kind; title = name; cwd; env; args = prog :: args }
+            { kind = Some kind; title = name; cwd; env; args = prog :: args;
+              args_can_be_interpreted_by_shell = None }
       in
       Lwt.return ());
   Lwt.return ()

src/debugger/core/symbols/bytecode.ml

@@ -3,6 +3,51 @@ open Instruct
 
 type debug_info = (Instruct.debug_event list * string list) list
 
+let seek_section (pos, section_table) name =
+  let rec seek_sec pos = function
+    | [] -> raise Not_found
+    | (name', len) :: rest ->
+        let pos = Int64.sub pos (Int64.of_int len) in
+        if name' = name then (pos, len) else seek_sec pos rest
+  in
+  seek_sec pos section_table
+
+[%%if ocaml_version >= (5, 2, 0)]
+
+(* Since 5.2, globals are numbered by [Symtable.Global.t] (compilation units and
+   predefined exceptions) rather than by [Ident.t]. *)
+let read_global_table ic toc =
+  let pos, _ = seek_section toc "SYMB" in
+  Lwt_io.set_position ic pos;%lwt
+  let module T = struct
+    type t = { cnt : int; tbl : int Symtable.Global.Map.t }
+  end in
+  let%lwt (global_table : T.t) = Lwt_io.read_value ic in
+  let ident_of_global global =
+    let name = Symtable.Global.name global in
+    match global with
+    | Symtable.Global.Glob_compunit _ -> Ident.create_persistent name
+    | Symtable.Global.Glob_predef _ -> Ident.create_predef name
+  in
+  Lwt.return
+    (global_table.tbl
+    |> Symtable.Global.Map.to_seq
+    |> Seq.map (fun (global, pos) -> (ident_of_global global, pos))
+    |> Ident.Map.of_seq)
+
+[%%else]
+
+let read_global_table ic toc =
+  let pos, _ = seek_section toc "SYMB" in
+  Lwt_io.set_position ic pos;%lwt
+  let module T = struct
+    type t = { cnt : int; tbl : int Ident.Map.t }
+  end in
+  let%lwt (global_table : T.t) = Lwt_io.read_value ic in
+  Lwt.return global_table.tbl
+
+[%%endif]
+
 let load_debuginfo file =
   let read_toc ic =
     let%lwt len = Lwt_io.length ic in
@@ -25,24 +70,6 @@ let load_debuginfo file =
     done;%lwt
     Lwt.return (pos_toc, !section_table)
   in
-  let seek_section (pos, section_table) name =
-    let rec seek_sec pos = function
-      | [] -> raise Not_found
-      | (name', len) :: rest ->
-          let pos = Int64.sub pos (Int64.of_int len) in
-          if name' = name then (pos, len) else seek_sec pos rest
-    in
-    seek_sec pos section_table
-  in
-  let read_global_table ic toc =
-    let pos, _ = seek_section toc "SYMB" in
-    Lwt_io.set_position ic pos;%lwt
-    let module T = struct
-      type t = { cnt : int; tbl : int Ident.Map.t }
-    end in
-    let%lwt (global_table : T.t) = Lwt_io.read_value ic in
-    Lwt.return global_table.tbl
-  in
   let relocate_event orig ev =
     ev.Instruct.ev_pos <- orig + ev.Instruct.ev_pos;
     match ev.ev_repr with Event_parent repr -> repr := ev.ev_pos | _ -> ()

src/debugger/dune

@@ -4,4 +4,4 @@
  (name debugger)
  (preprocess
   (pps lwt_ppx ppx_deriving.show ppx_deriving.make ppx_optcomp))
- (libraries ground ocaml-compiler-libs.common typenv trivia_check lwt lwt.unix lwt_react path_glob str iter))
+ (libraries ground ocaml-compiler-libs.common ocaml-compiler-libs.bytecomp typenv trivia_check lwt lwt.unix lwt_react path_glob str iter))

test/dap_client.ml

@@ -0,0 +1,182 @@
+(* A minimal DAP client, used by the integration tests to drive ocamlearlybird
+   the way an editor would: spawn the adapter, launch a bytecode program, stop
+   at a breakpoint and inspect the frames.
+
+   It talks to the adapter over the protocol rather than linking against its
+   internals.
+
+   The tests print a transcript on stdout which dune diffs against the recorded
+   .expected file, so anything printed by a test must be stable across the OCaml
+   versions we support (4.12 .. 5.x) and across platforms. *)
+
+open Debug_protocol
+
+(* ocamlearlybird extends the standard launch arguments; [program] is the
+   bytecode executable to debug. See src/adapter/debug_protocol_ex.ml. *)
+module Launch_command = struct
+  let type_ = Launch_command.type_
+
+  module Arguments = struct
+    type t = {
+      name : string;
+      program : string;
+      stop_on_entry : bool; [@key "stopOnEntry"]
+      console : string;
+    }
+    [@@deriving yojson { strict = false }]
+  end
+
+  module Result = Launch_command.Result
+end
+
+type t = {
+  rpc : Debug_rpc.t;
+  proc : Lwt_process.process;
+  stopped : Stopped_event.Payload.t Lwt_stream.t;
+}
+
+(* Fail rather than hang a CI run forever. *)
+let timeout = 60.0
+
+let with_timeout what f =
+  Lwt.pick
+    [
+      f ();
+      (Lwt_unix.sleep timeout;%lwt
+       Lwt.fail_with
+         (Printf.sprintf "timed out after %.0fs waiting for %s" timeout what));
+    ]
+
+(* [launch] must not wait for the launch response before setting breakpoints:
+   the adapter announces it is ready with an initialized event, expects the
+   breakpoints and a configurationDone in between, and only then replies. *)
+let launch ~adapter ~program ~source ~breakpoints =
+  let proc = Lwt_process.open_process (adapter, [| adapter; "debug" |]) in
+  let rpc = Debug_rpc.create ~in_:proc#stdout ~out:proc#stdin () in
+  let stopped =
+    Debug_rpc.event rpc (module Stopped_event) |> Lwt_react.E.to_stream
+  in
+  let initialized =
+    Debug_rpc.event rpc (module Initialized_event) |> Lwt_react.E.to_stream
+  in
+  Lwt.async (fun () -> Debug_rpc.start rpc);
+  let%lwt _ =
+    Debug_rpc.exec_command rpc
+      (module Initialize_command)
+      Initialize_command.Arguments.(
+        make ~adapter_id:"ocaml" ~lines_start_at1:(Some true)
+          ~columns_start_at1:(Some true) ())
+  in
+  let launched =
+    Debug_rpc.exec_command rpc
+      (module Launch_command)
+      Launch_command.Arguments.
+        {
+          name = "integration test";
+          program;
+          stop_on_entry = false;
+          console = "internalConsole";
+        }
+  in
+  with_timeout "initialized event" (fun () -> Lwt_stream.next initialized);%lwt
+  let%lwt _ =
+    Debug_rpc.exec_command rpc
+      (module Set_breakpoints_command)
+      Set_breakpoints_command.Arguments.(
+        make
+          ~source:Source.(make ~path:(Some source) ())
+          ~breakpoints:
+            (Some
+               (breakpoints |> List.map (fun line -> Source_breakpoint.(make ~line ()))))
+          ())
+  in
+  let%lwt _ =
+    Debug_rpc.exec_command rpc
+      (module Configuration_done_command)
+      ()
+  in
+  let%lwt () = with_timeout "launch response" (fun () -> launched) in
+  Lwt.return { rpc; proc; stopped }
+
+let wait_stopped t =
+  with_timeout "stopped event" (fun () -> Lwt_stream.next t.stopped)
+
+let stack_trace t ~thread_id =
+  let%lwt res =
+    Debug_rpc.exec_command t.rpc
+      (module Stack_trace_command)
+      Stack_trace_command.Arguments.(make ~thread_id ())
+  in
+  Lwt.return res.Stack_trace_command.Result.stack_frames
+
+let top_frame t ~thread_id =
+  match%lwt stack_trace t ~thread_id with
+  | [] -> Lwt.fail_with "no stack frames"
+  | frame :: _ -> Lwt.return frame
+
+(* The scopes of [frame], each with its variables, in the order the adapter
+   reports them.
+
+   The pseudo-variables the adapter synthesises (%accu, the bytecode
+   accumulator) are dropped. Whether they show up depends on the kind of debug
+   event the breakpoint landed on. *)
+let scopes t ~(frame : Stack_frame.t) =
+  let%lwt res =
+    Debug_rpc.exec_command t.rpc
+      (module Scopes_command)
+      Scopes_command.Arguments.(make ~frame_id:frame.id)
+  in
+  res.Scopes_command.Result.scopes
+  |> Lwt_list.map_s (fun (scope : Scope.t) ->
+         let%lwt res =
+           Debug_rpc.exec_command t.rpc
+             (module Variables_command)
+             Variables_command.Arguments.(
+               make ~variables_reference:scope.variables_reference ())
+         in
+         let variables =
+           res.Variables_command.Result.variables
+           |> List.filter (fun (variable : Variable.t) ->
+                  not (String.length variable.name > 0 && variable.name.[0] = '%'))
+         in
+         Lwt.return (scope.name, variables))
+
+let string_of_reason (reason : Stopped_event.Payload.Reason.t) =
+  match reason with
+  | Breakpoint -> "breakpoint"
+  | Entry -> "entry"
+  | Step -> "step"
+  | Exception -> "exception"
+  | Pause -> "pause"
+  | _ -> "other"
+
+let disconnect t =
+  (try%lwt
+     Debug_rpc.exec_command t.rpc
+       (module Disconnect_command)
+       Disconnect_command.Arguments.(make ~terminate_debuggee:(Some true) ())
+   with _ -> Lwt.return ());%lwt
+  t.proc#terminate;
+  Lwt.return ()
+
+(* Run [f] against a freshly launched adapter, tearing it down afterwards. *)
+let with_session ~program ~source ~breakpoints f =
+  let adapter =
+    match Sys.getenv_opt "EARLYBIRD_ADAPTER" with
+    | Some adapter -> adapter
+    | None -> failwith "EARLYBIRD_ADAPTER is not set"
+  in
+  (* The adapter resolves the debuggee's sources relative to its own working
+     directory, using the search dirs recorded in the bytecode; so it is run
+     from the directory the fixture was compiled in, and everything handed to it
+     has to be an absolute path. *)
+  let absolute path =
+    if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path
+    else path
+  in
+  let adapter = absolute adapter in
+  let program = absolute program in
+  let source = absolute source in
+  Sys.chdir (Filename.dirname program);
+  let%lwt t = launch ~adapter ~program ~source ~breakpoints in
+  (f t) [%finally disconnect t]

test/dune

@@ -0,0 +1,58 @@
+; Integration tests. Each test runs the real debug adapter against the bytecode
+; program in fixtures/, drives it over the debug adapter protocol just like an
+; editor would, and diffs the transcript it prints against a recorded .expected
+; file. Adding a test means adding a scenario module plus the two rules below.
+
+(library
+ (name dap_client)
+ (modules dap_client)
+ (preprocess
+  (pps lwt_ppx ppx_deriving_yojson))
+ (libraries dap.types dap.rpc_lwt lwt lwt.unix lwt_react))
+
+(executables
+ (names test_scopes test_frames)
+ (modules test_scopes test_frames)
+ (preprocess
+  (pps lwt_ppx))
+ (libraries dap.types dap_client lwt lwt.unix))
+
+(rule
+ (targets test_scopes.actual)
+ (deps
+  (:driver test_scopes.exe)
+  (:adapter %{exe:../src/main/main.exe})
+  fixtures/hello.bc
+  fixtures/hello.ml)
+ (action
+  (setenv
+   EARLYBIRD_ADAPTER
+   %{adapter}
+   (with-stdout-to
+    %{targets}
+    (run %{driver})))))
+
+(rule
+ (alias runtest)
+ (action
+  (diff test_scopes.expected test_scopes.actual)))
+
+(rule
+ (targets test_frames.actual)
+ (deps
+  (:driver test_frames.exe)
+  (:adapter %{exe:../src/main/main.exe})
+  fixtures/hello.bc
+  fixtures/hello.ml)
+ (action
+  (setenv
+   EARLYBIRD_ADAPTER
+   %{adapter}
+   (with-stdout-to
+    %{targets}
+    (run %{driver})))))
+
+(rule
+ (alias runtest)
+ (action
+  (diff test_frames.expected test_frames.actual)))

test/fixtures/dune

@@ -0,0 +1,10 @@
+; The debuggee used by the integration tests. It is compiled with ocamlc
+; directly rather than with an (executable) stanza so that the debug information
+; records this directory as a search dir, which is what lets the adapter resolve
+; hello.ml back from the bytecode.
+
+(rule
+ (targets hello.bc)
+ (deps hello.ml)
+ (action
+  (run %{bin:ocamlc} -g hello.ml -o hello.bc)))

test/fixtures/hello.ml

@@ -0,0 +1,13 @@
+(* Fixture program debugged by the integration tests. Keep the line numbers
+   stable as the tests set breakpoints by line. *)
+
+let greet name =
+  let greeting = "Hello, " ^ name in
+  greeting
+
+let () =
+  let x = 41 in
+  let y = x + 1 in
+  let msg = greet "world" in
+  print_endline msg;
+  print_endline (string_of_int y)