package vcaml

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file test_keyboard_interrupts.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
open Core
open Async
open Import
open Vcaml
open Vcaml_test_helpers


[%%import "config_ext.h"]
[%%if defined JSC_LINUX_EXT && defined JSC_UNIX_PTY]

let posix_openpt = ok_exn Unix_pseudo_terminal.posix_openpt
let grantpt = ok_exn Unix_pseudo_terminal.grantpt
let unlockpt = ok_exn Unix_pseudo_terminal.unlockpt
let ptsname = ok_exn Unix_pseudo_terminal.ptsname

let run_neovim_with_pty ~time_source ~f =
  let pty_master = posix_openpt [ O_RDWR; O_NOCTTY ] in
  grantpt pty_master;
  unlockpt pty_master;
  Expect_test_helpers_async.with_temp_dir (fun tmp_dir ->
    let socket = tmp_dir ^/ "socket" in
    match Core_unix.fork () with
    | `In_the_child ->
      let (_ : int) = Core_unix.Terminal_io.setsid () in
      let pty_slave = Core_unix.openfile ~mode:[ O_RDWR ] (ptsname pty_master) in
      Core_unix.dup2 ~src:pty_slave ~dst:Core_unix.stdin ();
      Core_unix.dup2 ~src:pty_slave ~dst:Core_unix.stdout ();
      Core_unix.dup2 ~src:pty_slave ~dst:Core_unix.stderr ();
      Core_unix.close pty_slave;
      (* There is some undocumented internal limit for the socket length (it doesn't
         appear in `:h limits`) so to ensure we create a socket we set the working dir
         to [tmp_dir] and create the socket with a relative path. *)
      Core_unix.chdir tmp_dir;
      let prog = neovim_path in
      (* We do *not* want to run with --headless here. *)
      Core_unix.exec
        ()
        ~prog
        ~argv:[ prog; "-n"; "--clean"; "--listen"; "./socket" ]
        ~env:(`Extend [ "NVIM_RPLUGIN_MANIFEST", "rplugin.vim" ])
      |> never_returns
    | `In_the_parent nvim ->
      with_process_cleanup ~name:"nvim" nvim ~f:(fun () ->
        match%bind spin_until_nvim_creates_socket_file nvim ~socket with
        | `Nvim_crashed exit_or_signal -> return (`Already_reaped exit_or_signal)
        | `Socket_missing -> raise_s [%message "Socket was not created"]
        | `Socket_created ->
          let%bind client = socket_client socket ?time_source >>| ok_exn in
          let send_keys bytes =
            let buf = Bytes.of_string bytes in
            let bytes_written = Core_unix.single_write pty_master ~buf in
            assert (String.length bytes = bytes_written)
          in
          let%bind result = f ~tmp_dir ~client ~send_keys in
          let%map () = Client.close client in
          (match result with
           | `Closed -> `Need_to_reap `Patient
           | `Still_running -> `Need_to_reap `Impatient)))
;;

let%expect_test "Keyboard interrupt aborts simple RPC request" =
  Backtrace.elide := true;
  let%bind () =
    run_neovim_with_pty ~time_source:None ~f:(fun ~tmp_dir ~client ~send_keys ->
      let fifo = tmp_dir ^/ "fifo" in
      let%bind () = Unix.mkfifo fifo in
      let sleep =
        run_join
          [%here]
          client
          ([ writefile fifo ~contents:"Sleeping"; Nvim.command "sleep 100" ]
           |> Api_call.Or_error.all_unit)
      in
      let%bind reader = Reader.open_file fifo in
      let%bind message = Reader.read_line reader in
      print_s [%sexp (message : string Reader.Read_result.t)];
      send_keys "\003";
      let%bind sleep = sleep in
      print_s [%message (sleep : unit Or_error.t)];
      let%bind () = attempt_to_quit ~tmp_dir ~client in
      return `Closed)
  in
  [%expect
    {|
    (Ok Sleeping)
    (sleep
     (Error
      (("Called from"
        lib/vcaml/test/semantics/test_keyboard_interrupts.ml:LINE:COL)
       (("Vim returned error" "Keyboard interrupt" (error_type Exception))
        (index 1)))))
    ("nvim exited" (exit_or_signal (Ok ()))) |}];
  Backtrace.elide := false;
  return ()
;;

let on_keyboard_interrupt_abort_rpcrequest_and_notify_callback ~timeout ~time_source ~f =
  run_neovim_with_pty ~time_source ~f:(fun ~tmp_dir ~client ~send_keys ->
    let fifo = tmp_dir ^/ "fifo" in
    let%bind () = Unix.mkfifo fifo in
    let sent_keys = Ivar.create () in
    let block_nvim ~client =
      let blocking = Ivar.create () in
      let function_name = "rpc" in
      let call_rpc =
        (wrap_viml_function
           ~type_:Defun.Vim.(Integer @-> String @-> Nil @-> return Nil)
           ~function_name:"rpcrequest")
          (Client.channel client)
          function_name
          ()
      in
      register_request_blocking
        client
        ~name:function_name
        ~type_:Defun.Ocaml.Sync.(Nil @-> return Nil)
        ~f:(fun ~keyboard_interrupted ~client () ->
          Ivar.fill blocking ();
          upon keyboard_interrupted (fun () -> print_endline "Keyboard interrupt!");
          let%bind () = Ivar.read sent_keys in
          f client);
      let%bind result =
        run_join
          [%here]
          client
          ([ writefile fifo ~contents:"Calling RPC"; call_rpc ]
           |> Api_call.Or_error.all_unit)
      in
      let%map () = Ivar.read blocking in
      result
    in
    let rpc_result = block_nvim ~client in
    let%bind reader = Reader.open_file fifo in
    let%bind message = Reader.read_line reader in
    print_s [%sexp (message : string Reader.Read_result.t)];
    send_keys "\003";
    Ivar.fill sent_keys ();
    let rpc_result =
      let%bind rpc_result = rpc_result in
      let%bind () = attempt_to_quit ~tmp_dir ~client in
      return rpc_result
    in
    match timeout with
    | None ->
      let%map rpc_result = rpc_result in
      print_s [%message (rpc_result : unit Or_error.t)];
      `Closed
    | Some timeout ->
      let%map rpc_result = with_timeout timeout rpc_result in
      print_s [%message (rpc_result : unit Or_error.t Clock_ns.Or_timeout.t)];
      (match rpc_result with
       | `Timeout -> `Still_running
       | `Result _ -> `Closed))
;;

let%expect_test "Keyboard interrupt learned by RPC response aborts [rpcrequest] and \
                 notifies callback"
  =
  Backtrace.elide := true;
  let%bind () =
    on_keyboard_interrupt_abort_rpcrequest_and_notify_callback
      ~timeout:None
      ~f:(fun client ->
        let%map result = run_join [%here] client (Nvim.command "sleep 100") in
        print_s [%message "Result after interrupt" ~_:(result : unit Or_error.t)];
        result)
      ~time_source:None
  in
  (* Observe that even though the request in the body of the RPC fails due to the keyboard
     interrupt, the RPC returns an (Ok ()) result to ensure that control is returned
     immediately to the user without displaying an error message. *)
  [%expect
    {|
    (Ok "Calling RPC")
    Keyboard interrupt!
    ("Result after interrupt"
     (Error
      (("Called from"
        lib/vcaml/test/semantics/test_keyboard_interrupts.ml:LINE:COL)
       ("Vim returned error" "Keyboard interrupt" (error_type Exception)))))
    (rpc_result (Ok ()))
    ("nvim exited" (exit_or_signal (Ok ()))) |}];
  Backtrace.elide := false;
  return ()
;;

let%expect_test "Keyboard interrupt learned by heartbeating aborts [rpcrequest] and \
                 notifies callback"
  =
  let%bind () =
    on_keyboard_interrupt_abort_rpcrequest_and_notify_callback
      ~timeout:None
      ~time_source:(Some (Time_source.wall_clock ()))
      ~f:(fun _ -> Deferred.never () |> Deferred.ok)
  in
  [%expect
    {|
    (Ok "Calling RPC")
    Keyboard interrupt!
    (rpc_result (Ok ()))
    ("nvim exited" (exit_or_signal (Ok ()))) |}];
  return ()
;;

let%expect_test "Keyboard interrupt learned by ??? - Neovim's semantics have changed!" =
  let%bind () =
    on_keyboard_interrupt_abort_rpcrequest_and_notify_callback
      ~timeout:(Some Time_float.Span.second)
      ~time_source:None
      ~f:(fun _ -> Deferred.never () |> Deferred.ok)
  in
  (* If this test succeeds then Neovim's semantics around when it alerts have changed. We
     should investigate - heartbeating may no longer be required. *)
  [%expect
    {|
    (Ok "Calling RPC")
    (rpc_result Timeout)
    ("nvim exited" (exit_or_signal (Error (Exit_non_zero 1)))) |}];
  return ()
;;

[%%endif]
OCaml

Innovation. Community. Security.