Expand nREPL server regression coverage

Changed

 src/sigil/nrepl.sgl  |   8 ++++++++
 test/test-server.sgl | 123 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 129 insertions(+), 2 deletions(-)

Diff

src/sigil/nrepl.sglmodified

@@ -240,6 +240,7 @@

240

;; Dispatch on operation

241

(case op

242

((eval) (handle-eval client id args))

+243

((abort interrupt) (handle-abort client id args))

244

((complete) (handle-complete client id args))

245

((doc) (handle-doc client id args))

246

((describe) (handle-describe client id args))

@@ -470,6 +471,13 @@

471

(clear-debug-mode! client)

472

(make-response* client id 'ok ':in-debugger #f ':value "Returning to REPL"))

473

+474

(define (handle-abort client id args)

+475

(let ((target-id (get-arg args ':target-id #f)))

+476

(if (not target-id)

+477

(make-error-response* client id "missing-target-id" "No :target-id provided")

+478

(make-error-response* client id "not-found"

+479

(format "No running eval for request id ~a" target-id)))))

+480

481

;; complete - return completions for a prefix

482

;; Includes both value bindings and syntax/macro bindings

483

(define (handle-complete client id args)

test/test-server.sglmodified

@@ -24,6 +24,9 @@

(define (send-request sock request)

(socket-write sock (encode-test-message request)))

+27

(define (send-bytes sock bytes)

+28

(socket-write sock bytes))

+29

(define (read-at-least sock n acc attempts)

(cond

((<= attempts 0) #f)

@@ -69,6 +72,12 @@

(pump server 20)

(read-response sock))

+75

(define (list-contains? items value)

+76

(cond

+77

((null? items) #f)

+78

((equal? (car items) value) #t)

+79

(else (list-contains? (cdr items) value))))

+80

(define (with-server thunk)

(let ((server (nrepl-start *test-port*)))

(dynamic-wind

@@ -117,8 +126,7 @@

126

(let ((frames-resp (request-response server sock

127

'(request :id "frames" :op debug-frames))))

128

(assert-eq (response-ref frames-resp ':status #f) 'ok)

−120

(assert-true (response-ref frames-resp ':in-debugger #f)

−121

)

+129

(assert-true (response-ref frames-resp ':in-debugger #f))

130

(assert-true (string? (response-ref frames-resp ':frames #f))))

131

(let ((restarts-resp (request-response server sock

132

'(request :id "restarts" :op debug-restarts))))

@@ -134,4 +142,115 @@

142

(assert-equal (response-ref ok-resp ':value #f) "3"))

143

(socket-close sock))))))

144

+145

(test-group "nrepl advertised ops"

+146

(test "ping and info round-trip"

+147

(with-server

+148

(lambda (server)

+149

(let ((sock (tcp-connect "127.0.0.1" *test-port*)))

+150

(pump server 5)

+151

(let ((ping-resp (request-response server sock

+152

'(request :id "ping" :op ping))))

+153

(assert-eq (response-ref ping-resp ':status #f) 'ok)

+154

(assert-true (response-ref ping-resp ':pong #f)))

+155

(let ((info-resp (request-response server sock

+156

'(request :id "info" :op info))))

+157

(assert-eq (response-ref info-resp ':status #f) 'ok)

+158

(assert-equal (response-ref info-resp ':module #f) "(sigil user)"))

+159

(socket-close sock)))))

+160

+161

(test "complete, doc, describe, macroexpand, and modules round-trip"

+162

(with-server

+163

(lambda (server)

+164

(let ((sock (tcp-connect "127.0.0.1" *test-port*)))

+165

(pump server 5)

+166

(let ((complete-resp (request-response server sock

+167

'(request :id "complete" :op complete :prefix "ca"))))

+168

(assert-eq (response-ref complete-resp ':status #f) 'ok)

+169

(assert-true (list? (response-ref complete-resp ':completions #f))))

+170

(let ((doc-resp (request-response server sock

+171

'(request :id "doc" :op doc :symbol "car"))))

+172

(assert-eq (response-ref doc-resp ':status #f) 'ok))

+173

(let ((describe-resp (request-response server sock

+174

'(request :id "describe" :op describe :symbol "car"))))

+175

(assert-eq (response-ref describe-resp ':status #f) 'ok)

+176

(assert-equal (response-ref describe-resp ':name #f) "car"))

+177

(let ((macro-resp (request-response server sock

+178

'(request :id "macro" :op macroexpand :code "(when #t 1)"))))

+179

(assert-eq (response-ref macro-resp ':status #f) 'ok)

+180

(assert-true (string? (response-ref macro-resp ':expansion #f))))

+181

(let ((modules-resp (request-response server sock

+182

'(request :id "modules" :op modules))))

+183

(assert-eq (response-ref modules-resp ':status #f) 'ok)

+184

(assert-equal (response-ref modules-resp ':current #f) "(sigil user)")

+185

(assert-true (list? (response-ref modules-resp ':modules #f))))

+186

(socket-close sock)))))

+187

+188

(test "abort and interrupt validate provisional target-id protocol"

+189

(with-server

+190

(lambda (server)

+191

(let ((sock (tcp-connect "127.0.0.1" *test-port*)))

+192

(pump server 5)

+193

(let ((missing-resp (request-response server sock

+194

'(request :id "abort-missing" :op abort))))

+195

(assert-eq (response-ref missing-resp ':status #f) 'error)

+196

(assert-equal (response-ref missing-resp ':code #f) "missing-target-id"))

+197

(let ((not-found-resp (request-response server sock

+198

'(request :id "abort-unknown" :op interrupt :target-id "nope"))))

+199

(assert-eq (response-ref not-found-resp ':status #f) 'error)

+200

(assert-equal (response-ref not-found-resp ':code #f) "not-found"))

+201

(socket-close sock))))))

+202

+203

(test-group "nrepl framing"

+204

(test "partial message reassembly waits for a complete frame"

+205

(with-server

+206

(lambda (server)

+207

(let* ((sock (tcp-connect "127.0.0.1" *test-port*))

+208

(bytes (encode-test-message

+209

'(request :id "partial" :op eval :code "(+ 2 3)")))

+210

(split 7))

+211

(pump server 5)

+212

(send-bytes sock (bytevector-copy bytes 0 split))

+213

(pump server 10)

+214

(assert-false (socket-ready? sock 20))

+215

(send-bytes sock (bytevector-copy bytes split))

+216

(pump server 20)

+217

(let ((resp (read-response sock)))

+218

(assert-eq (response-ref resp ':status #f) 'ok)

+219

(assert-equal (response-ref resp ':value #f) "5"))

+220

(socket-close sock))))))

+221

+222

(test-group "nrepl eval semantics"

+223

(test "module context is applied per request"

+224

(with-server

+225

(lambda (server)

+226

(let ((sock (tcp-connect "127.0.0.1" *test-port*)))

+227

(pump server 5)

+228

(let ((resp (request-response server sock

+229

'(request :id "module-eval" :op eval :module "(sigil user)" :code "(+ 6 7)"))))

+230

(assert-eq (response-ref resp ':status #f) 'ok)

+231

(assert-equal (response-ref resp ':module #f) "(sigil user)")

+232

(assert-equal (response-ref resp ':value #f) "13"))

+233

(socket-close sock)))))

+234

+235

(test "redefinition takes effect at name-based call sites"

+236

(with-server

+237

(lambda (server)

+238

(let ((sock (tcp-connect "127.0.0.1" *test-port*)))

+239

(pump server 5)

+240

(request-response server sock

+241

'(request :id "def-1" :op eval :code "(define (nrepl-test-base) 1)"))

+242

(request-response server sock

+243

'(request :id "def-caller" :op eval :code "(define (nrepl-test-caller) (nrepl-test-base))"))

+244

(let ((first (request-response server sock

+245

'(request :id "first-call" :op eval :code "(nrepl-test-caller)"))))

+246

(assert-eq (response-ref first ':status #f) 'ok)

+247

(assert-equal (response-ref first ':value #f) "1"))

+248

(request-response server sock

+249

'(request :id "def-2" :op eval :code "(define (nrepl-test-base) 2)"))

+250

(let ((second (request-response server sock

+251

'(request :id "second-call" :op eval :code "(nrepl-test-caller)"))))

+252

(assert-eq (response-ref second ':status #f) 'ok)

+253

(assert-equal (response-ref second ':value #f) "2"))

+254

(socket-close sock))))))

+255

256

(run-tests)