Add interrupt/abort and incremental output streaming

Message

Wire the 0.17.9 regvm preemptive-yield and custom output-port primitives into (sigil nrepl) so live-coding is stream-safe and responsive.

Sliced eval tasks: expression-form evals run cooperatively, one preemptive-yield slice per nrepl-process-pending, so a CPU-bound eval (e.g. (let loop () (loop))) no longer freezes the host loop. An (:op abort :target-id <eval-id>) from a second connection drops the suspended continuation; the interrupted eval receives :status error :code "interrupted" and the session survives.

Output streaming: around each slice, current-output-port/current-error-port are redirected to custom callback ports that buffer writes; buffered chunks are flushed back as incremental (response :status out :out <chunk>) / :err frames carrying the original eval request id, so a long eval's prints arrive as they happen rather than batched at completion.

Definition forms (define/define-syntax/import/begin-with-defs/...) eval immediately at top level (preserving module-level define semantics) and are not sliced; yield is armed only around the sliced expression path, so there is zero preemption overhead off that path. This hybrid works around a VM limitation: preemptive yield does not propagate across the eval native boundary (nested sigil_vmexecute), so sliceable expressions are run as ((eval (list 'lambda '() form))) — a bytecode call in the prompt-bearing invocation where yields propagate.

Tests: abort interrupts a runaway loop + session survives; output streams incrementally (frames precede the final response and arrive while the eval is still suspended); malformed non-string :target-id does not crash the server. Existing suite stays green (17 total).

Changed

 src/sigil/nrepl.sgl  | 323 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------
 test/test-server.sgl | 177 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 486 insertions(+), 14 deletions(-)

Diff

src/sigil/nrepl.sglmodified

@@ -24,6 +24,7 @@

(sigil inspect)

(sigil error)

(sigil diagnostic)

+27

(sigil async) ; Provides: async-prompt-tag (for preemptive-yield slicing)

(sigil repl) ; Provides: make-prompt, make-debug-prompt, format-srcloc,

; format-proc-name, format-backtrace-str, format-frame-str,

; debug-help-text, parse-debug-command, string->int,

@@ -76,11 +77,12 @@

;; DATA STRUCTURES

;; ============================================================

−79

;; Server state: (vector 'nrepl-server socket port sessions)

+80

;; Server state: (vector 'nrepl-server socket port sessions clients tasks)

;; sessions is an alist of (session-id . session-state)

+82

;; tasks is a list of pending sliced eval tasks (see below)

(define (make-nrepl-server socket port)

−83

(vector 'nrepl-server socket port '() '()))

+85

(vector 'nrepl-server socket port '() '() '()))

(define (nrepl-server? obj)

(and (vector? obj)

@@ -105,6 +107,60 @@

107

(define (nrepl-clients-set! server clients)

108

(vector-set! server 4 clients))

109

+110

(define (nrepl-tasks server)

+111

(vector-ref server 5))

+112

+113

(define (nrepl-tasks-set! server tasks)

+114

(vector-set! server 5 tasks))

+115

+116

;; ============================================================

+117

;; SLICED EVAL TASKS

+118

;; ============================================================

+119

;;

+120

;; A CPU-bound eval (e.g. a runaway loop) must not freeze the host's

+121

;; cooperative loop. Expression-form evals run as *sliced tasks*: each

+122

;; call to nrepl-process-pending runs one preemptive-yield slice of the

+123

;; eval, so an `abort` op from a second connection can interrupt it and

+124

;; the host loop keeps turning. Output produced during the eval is

+125

;; buffered per slice and flushed back as incremental :out/:err frames.

+126

;;

+127

;; Task: (vector 'nrepl-eval-task client id thunk k response

+128

;; done? aborted? outbuf out-port err-port)

+129

;; thunk - runs the (sliced) eval, returns the final response

+130

;; k - captured continuation while the eval is suspended, else #f

+131

;; response - the final response to send when done

+132

;; outbuf - reverse-order list of (kind . string) chunks awaiting flush

+133

;; out-port / err-port - custom output ports that buffer into outbuf

+134

(define (make-eval-task client id thunk)

+135

(let ((task (vector 'nrepl-eval-task client id thunk #f #f #f #f '() #f #f)))

+136

(vector-set! task 9

+137

(make-custom-output-port

+138

(lambda (chunk) (task-buffer-add! task 'out chunk))))

+139

(vector-set! task 10

+140

(make-custom-output-port

+141

(lambda (chunk) (task-buffer-add! task 'err chunk))))

+142

task))

+143

+144

(define (eval-task-client task) (vector-ref task 1))

+145

(define (eval-task-id task) (vector-ref task 2))

+146

(define (eval-task-thunk task) (vector-ref task 3))

+147

(define (eval-task-k task) (vector-ref task 4))

+148

(define (eval-task-k-set! task k) (vector-set! task 4 k))

+149

(define (eval-task-response task) (vector-ref task 5))

+150

(define (eval-task-response-set! task response) (vector-set! task 5 response))

+151

(define (eval-task-done? task) (vector-ref task 6))

+152

(define (eval-task-done-set! task done?) (vector-set! task 6 done?))

+153

(define (eval-task-aborted? task) (vector-ref task 7))

+154

(define (eval-task-aborted-set! task aborted?) (vector-set! task 7 aborted?))

+155

(define (eval-task-outbuf task) (vector-ref task 8))

+156

(define (eval-task-outbuf-set! task buf) (vector-set! task 8 buf))

+157

(define (eval-task-out-port task) (vector-ref task 9))

+158

(define (eval-task-err-port task) (vector-ref task 10))

+159

+160

(define (task-buffer-add! task kind chunk)

+161

(eval-task-outbuf-set! task

+162

(cons (cons kind chunk) (eval-task-outbuf task))))

+163

164

    ;; Client connection: (vector 'nrepl-client socket buffer session-id module debug-mode? debug-error debug-trace debug-frame debug-on-error?)

165

;; debug-mode?: #t when client is in debug mode after an error

166

;; debug-error: the error message string when in debug mode

@@ -237,10 +293,13 @@

293

(let ((mod (find-module (read-expr module-name))))

294

(when mod

295

(client-module-set! client mod))))

−240

;; Dispatch on operation

+296

;; Dispatch on operation.

+297

;; NOTE: the server path (nrepl-handle-request*) intercepts eval

+298

;; and abort so they run through the sliced-task machinery; the

+299

;; cases here are for standalone/direct callers (no server state).

300

(case op

−242

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

−243

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

+301

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

+302

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

303

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

304

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

305

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

@@ -380,7 +439,11 @@

439

;; Catches both Scheme exceptions (via guard) and VM errors (via vm-error-prompt-tag)

440

;; Default wire sessions return structured errors and remain in normal eval mode.

441

;; Debug mode is entered only when the session's debug-on-error policy is enabled.

−383

(define (handle-eval client id args)

+442

;;

+443

;; sliced?: when #t the user form is run as a preemptive-yield-abortable

+444

;; call (see evaluate-user-code). The server passes #t for sliceable

+445

;; expression forms; definition forms and standalone callers pass #f.

+446

(define (handle-eval client id args sliced?)

447

(let ((code (get-arg args ':code ""))

448

(fmt (get-arg args ':format #f)))

449

(if (string=? code "")

@@ -427,7 +490,7 @@

490

(make-response* client id 'exit ':value "Goodbye!")

491

(make-response* client id 'ok ':value "ok")))

492

;; Regular evaluation

−430

(let ((value (eval (read-expr code))))

+493

(let ((value (evaluate-user-code code sliced?)))

494

(set-current-module! saved-module)

495

(make-response* client id 'ok

496

':value (if structured?

@@ -435,6 +498,29 @@

498

(format "~s" value))))))))))

499

result))))))

500

+501

;; Evaluate the user's code form and return its value.

+502

;;

+503

;; sliced? #f: evaluate the form directly (top-level semantics preserved —

+504

;; `define` lands at module level). Used for definition forms and

+505

;; standalone callers.

+506

;; sliced? #t: build (lambda () <form>) and CALL it, so the yield-bearing

+507

;; work runs as a bytecode OP_CALL in the prompt-bearing invocation and

+508

;; is preemptible/abortable. Only valid for expression forms — a top-level

+509

;; `define` here would become a local binding. The form is classified as

+510

;; sliceable before we get here (see sliceable-form?).

+511

;;

+512

;; Why the lambda dance: the `eval` native runs code in a nested VM

+513

;; invocation (sigil__vm_execute), and a preemptive yield tripped inside it

+514

;; cannot abort to the async prompt installed in the OUTER invocation. By

+515

;; eval'ing only `(lambda () form)` (which completes immediately, producing

+516

;; a closure) and then calling that closure ourselves, the user code runs

+517

;; in the current, prompt-bearing invocation where yields propagate.

+518

(define (evaluate-user-code code sliced?)

+519

(let ((form (read-expr code)))

+520

(if sliced?

+521

((eval (list 'lambda '() form)))

+522

(eval form))))

+523

524

(define (handle-debug-policy client id args)

525

(let ((enabled? (get-arg args ':debug-on-error #f)))

526

(client-debug-on-error-set! client (and enabled? #t))

@@ -471,13 +557,218 @@

557

(clear-debug-mode! client)

558

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

559

−474

(define (handle-abort client id args)

+560

;; abort/interrupt for a standalone (no-server) caller: there is no task

+561

;; registry, so validate the request shape and report not-found.

+562

(define (handle-abort-standalone client id args)

563

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

564

(if (not target-id)

565

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

566

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

567

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

568

+569

;; ============================================================

+570

;; SLICED EVAL: classification, dispatch, execution

+571

;; ============================================================

+572

+573

;; Heads of top-level definition forms. These must be evaluated with

+574

;; top-level semantics (so `define` lands at module level) and complete

+575

;; immediately, so they are NOT sliced.

+576

(define definition-form-heads

+577

'(define define-values define-syntax define-record-type define-library

+578

define-constant define-structure define-parameter

+579

import include include-ci load-module use require))

+580

+581

(define (definition-form? form)

+582

(and (pair? form)

+583

(or (memq (car form) definition-form-heads)

+584

;; A begin containing any definition must run at top level.

+585

(and (eq? (car form) 'begin)

+586

(any-definition? (cdr form))))))

+587

+588

(define (any-definition? forms)

+589

(cond

+590

((null? forms) #f)

+591

((definition-form? (car forms)) #t)

+592

(else (any-definition? (cdr forms)))))

+593

+594

;; A form is sliceable (run preemptibly as a lambda call) when it is an

+595

;; expression, not a top-level definition. Non-pairs (literals, symbols)

+596

;; are trivially sliceable but complete in one slice.

+597

(define (sliceable-form? form)

+598

(not (definition-form? form)))

+599

+600

;; Server-aware eval dispatch. Sliceable expression forms become pending

+601

;; tasks (response delivered later, after slicing); definition forms and

+602

;; anything we cannot classify run immediately through handle-eval.

+603

(define (handle-eval-request server client id args)

+604

(let ((code (get-arg args ':code "")))

+605

(if (or (string=? code "")

+606

(client-debug-mode? client))

+607

;; Empty code / debug-command handling stays on the immediate path.

+608

(handle-eval client id args #f)

+609

(let ((form (guard (exn (else 'unreadable)) (read-expr code))))

+610

(if (and (not (eq? form 'unreadable)) (sliceable-form? form))

+611

(begin (enqueue-eval-task! server client id args) #f)

+612

;; Definition form, or unreadable (let handle-eval surface

+613

;; the read/eval error through its structured-error path).

+614

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

+615

+616

(define (enqueue-eval-task! server client id args)

+617

(let ((task (make-eval-task client id

+618

(lambda () (handle-eval client id args #t)))))

+619

(nrepl-tasks-set! server (append (nrepl-tasks server) (list task)))))

+620

+621

;; equal? (not string=?) so a client-supplied :target-id of an unexpected

+622

;; type (number, symbol) simply fails to match instead of raising a

+623

;; type-error that would unwind through the whole server loop.

+624

(define (find-task-by-id server target-id)

+625

(let loop ((tasks (nrepl-tasks server)))

+626

(cond

+627

((null? tasks) #f)

+628

((equal? (eval-task-id (car tasks)) target-id) (car tasks))

+629

(else (loop (cdr tasks))))))

+630

+631

;; The interrupted-eval response delivered to the ORIGINAL eval client

+632

;; when its running eval is aborted. Shape mirrors a structured error so

+633

;; existing error-handling clients cope: :status error :code "interrupted".

+634

(define (make-interrupted-response client id)

+635

(make-response* client id 'error

+636

':code "interrupted"

+637

':message "Evaluation interrupted"

+638

':error (list ':type "interrupted"

+639

':message "Evaluation interrupted"

+640

':repr "interrupted")

+641

':stack ""

+642

':in-debugger #f))

+643

+644

(define (handle-abort server client id args)

+645

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

+646

(if (not target-id)

+647

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

+648

(let ((task (find-task-by-id server target-id)))

+649

(if task

+650

(begin

+651

;; Deliver any output produced before the interruption,

+652

;; then drop the suspended continuation and mark the task

+653

;; done with the interrupted response.

+654

(flush-eval-task-output! task)

+655

(eval-task-aborted-set! task #t)

+656

(eval-task-k-set! task #f)

+657

(eval-task-response-set! task

+658

(make-interrupted-response (eval-task-client task)

+659

(eval-task-id task)))

+660

(eval-task-done-set! task #t)

+661

(make-response* client id 'ok ':aborted target-id))

+662

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

+663

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

+664

+665

;; Run one preemptive-yield slice of a pending eval task. On first entry

+666

;; the task thunk starts; on later entries the captured continuation

+667

;; resumes. When the eval yields, the continuation is captured and the

+668

;; task stays pending; when it returns, its value becomes the response.

+669

(define (run-eval-task-slice! task)

+670

(when (and (not (eval-task-done? task))

+671

(not (eval-task-aborted? task)))

+672

(let ((saved-module (current-module))

+673

(saved-out (current-output-port))

+674

(saved-err (current-error-port)))

+675

;; Redirect output to the task's buffering ports and enter the

+676

;; client's module for the duration of this slice.

+677

(set-current-module! (client-module (eval-task-client task)))

+678

(current-output-port (eval-task-out-port task))

+679

(current-error-port (eval-task-err-port task))

+680

(set-vm-async-prompt-tag! async-prompt-tag)

+681

(set-vm-yield-requested! #t)

+682

(let ((result

+683

(call-with-prompt

+684

async-prompt-tag

+685

;; Yield handler: capture the continuation, stay pending.

+686

(lambda (k op-type arg1 arg2)

+687

(set-vm-yield-requested! #f)

+688

(eval-task-k-set! task k)

+689

'yielded)

+690

;; Body: resume the suspended eval, or start it.

+691

(lambda ()

+692

(let ((k (eval-task-k task)))

+693

(if k

+694

(begin (eval-task-k-set! task #f) (k #f))

+695

((eval-task-thunk task))))))))

+696

;; Restore VM/dynamic state before returning to the server loop.

+697

(set-vm-yield-requested! #f)

+698

(set-current-module! saved-module)

+699

(current-output-port saved-out)

+700

(current-error-port saved-err)

+701

(unless (eq? result 'yielded)

+702

(eval-task-response-set! task result)

+703

(eval-task-done-set! task #t))))))

+704

+705

;; Flush buffered eval output as incremental :out/:err frames to the eval

+706

;; client, carrying the original eval request id. Runs in the server loop

+707

;; (yield disarmed, ports restored), so socket writes are safe here.

+708

(define (flush-eval-task-output! task)

+709

(let ((buf (reverse (eval-task-outbuf task)))

+710

(client (eval-task-client task))

+711

(id (eval-task-id task)))

+712

(eval-task-outbuf-set! task '())

+713

(for-each

+714

(lambda (entry)

+715

(let ((kind (car entry))

+716

(chunk (cdr entry)))

+717

(socket-write (client-socket client)

+718

(encode-message

+719

(if (eq? kind 'err)

+720

(list 'response ':id id ':status 'err ':err chunk)

+721

(list 'response ':id id ':status 'out ':out chunk))))))

+722

buf)))

+723

+724

(define (send-eval-task-response! task)

+725

(let ((response (eval-task-response task))

+726

(client (eval-task-client task)))

+727

(when response

+728

(socket-write (client-socket client)

+729

(encode-message response)))))

+730

+731

;; Advance every pending eval task by one slice, flushing streamed output

+732

;; and sending final responses for completed tasks. A task whose eval

+733

;; client has disconnected is dropped (not sliced, not written to) so an

+734

;; orphaned runaway eval can't slice forever or write to a closed socket.

+735

(define (process-eval-tasks server)

+736

(let loop ((tasks (nrepl-tasks server))

+737

(remaining '()))

+738

(if (null? tasks)

+739

(nrepl-tasks-set! server (reverse remaining))

+740

(let ((task (car tasks)))

+741

(cond

+742

((socket-closed? (client-socket (eval-task-client task)))

+743

;; Client gone: abandon the task.

+744

(loop (cdr tasks) remaining))

+745

(else

+746

(run-eval-task-slice! task)

+747

(flush-eval-task-output! task)

+748

(if (eval-task-done? task)

+749

(begin

+750

(send-eval-task-response! task)

+751

(loop (cdr tasks) remaining))

+752

(loop (cdr tasks) (cons task remaining)))))))))

+753

+754

;; Server-aware request dispatch: eval and abort route through the sliced

+755

;; task machinery; everything else delegates to nrepl-handle-request.

+756

(define (nrepl-handle-request* server client request)

+757

(if (not (and (pair? request) (eq? (car request) 'request)))

+758

(make-error-response "unknown" "invalid-request" "Expected (request ...)")

+759

(let* ((args (cdr request))

+760

(id (get-arg args ':id "unknown"))

+761

(op (get-arg args ':op #f))

+762

(module-name (get-arg args ':module #f)))

+763

(when (and module-name (string? module-name) (not (string=? module-name "")))

+764

(let ((mod (find-module (read-expr module-name))))

+765

(when mod

+766

(client-module-set! client mod))))

+767

(case op

+768

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

+769

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

+770

(else (nrepl-handle-request client request))))))

+771

772

;; complete - return completions for a prefix

773

;; Includes both value bindings and syntax/macro bindings

774

(define (handle-complete client id args)

@@ -639,7 +930,9 @@

930

;; Accept new connections

931

(accept-pending-connections server)

932

;; Process data from existing clients

−642

(process-client-data server)))

+933

(process-client-data server)

+934

;; Advance each pending sliced eval task by one slice

+935

(process-eval-tasks server)))

936

937

;; Accept any pending connections

938

(define (accept-pending-connections server)

@@ -696,11 +989,13 @@

989

(let ((message (car result))

990

(remaining (cdr result)))

991

(client-buffer-set! client remaining)

−699

;; Handle the request

−700

(let ((response (nrepl-handle-request client message)))

−701

;; Send response

−702

(socket-write (client-socket client)

−703

(encode-message response)))

+992

;; Handle the request via the server-aware dispatcher. Sliced

+993

;; eval requests return #f here (their response is delivered later

+994

;; by process-eval-tasks); everything else responds immediately.

+995

(let ((response (nrepl-handle-request* server client message)))

+996

(when response

+997

(socket-write (client-socket client)

+998

(encode-message response))))

999

;; Check for more messages

1000

(process-client-messages server client)))))

1001

test/test-server.sglmodified

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

(nrepl-process-pending server)

(pump server (- n 1))))

+72

;; Buffered stream reader. Streamed eval produces MULTIPLE frames that can

+73

;; arrive coalesced in a single TCP segment, so a reader must preserve bytes

+74

;; beyond the first frame. A conn wraps a socket plus a leftover byte buffer.

+75

(define (make-conn sock) (vector sock (make-bytevector 0)))

+76

(define (conn-sock c) (vector-ref c 0))

+77

(define (conn-buf c) (vector-ref c 1))

+78

(define (conn-buf-set! c b) (vector-set! c 1 b))

+79

+80

;; Decode one frame from a byte buffer; returns (frame . remaining) or #f.

+81

(define (conn-try-decode buf)

+82

(if (< (bytevector-length buf) 4)

+83

#f

+84

(let* ((len (+ (* (bytevector-u8-ref buf 0) 16777216)

+85

(* (bytevector-u8-ref buf 1) 65536)

+86

(* (bytevector-u8-ref buf 2) 256)

+87

(bytevector-u8-ref buf 3)))

+88

(total (+ 4 len)))

+89

(if (< (bytevector-length buf) total)

+90

#f

+91

(cons (read-expr (utf8->string (bytevector-copy buf 4 total)))

+92

(bytevector-copy buf total))))))

+93

+94

;; Read one frame from a conn, polling the socket up to `attempts` times.

+95

(define (conn-read-frame c attempts)

+96

(let loop ((att attempts))

+97

(let ((dec (conn-try-decode (conn-buf c))))

+98

(if dec

+99

(begin (conn-buf-set! c (cdr dec)) (car dec))

+100

(if (<= att 0)

+101

#f

+102

(begin

+103

(when (socket-ready? (conn-sock c) 20)

+104

(let ((d (socket-read-bytevector (conn-sock c))))

+105

(when (and d (not (eof-object? d)) (> (bytevector-length d) 0))

+106

(conn-buf-set! c (bytevector-append (conn-buf c) d)))))

+107

(loop (- att 1))))))))

+108

+109

;; Read framed responses from a conn until one carries a terminal status

+110

;; (ok/error/exit) or max frames are read. Returns the frames in wire order.

+111

;; Used to observe streamed :out/:err frames that precede the final response.

+112

(define (conn-read-until-final c max)

+113

(let loop ((i 0) (acc '()))

+114

(if (>= i max)

+115

(reverse acc)

+116

(let ((resp (conn-read-frame c 60)))

+117

(if resp

+118

(let ((acc2 (cons resp acc)))

+119

(if (memq (response-ref resp ':status #f) '(ok error exit))

+120

(reverse acc2)

+121

(loop (+ i 1) acc2)))

+122

(reverse acc))))))

+123

+124

(define (frames-with-status frames status)

+125

(cond

+126

((null? frames) '())

+127

((eq? (response-ref (car frames) ':status #f) status)

+128

(cons (car frames) (frames-with-status (cdr frames) status)))

+129

(else (frames-with-status (cdr frames) status))))

+130

+131

(define (any-chunk-contains? frames key needle)

+132

(cond

+133

((null? frames) #f)

+134

((let ((v (response-ref (car frames) key #f)))

+135

(and (string? v) (string-contains? v needle))) #t)

+136

(else (any-chunk-contains? (cdr frames) key needle))))

+137

138

(define (request-response server sock request)

139

(send-request sock request)

140

(pump server 20)

@@ -295,4 +361,115 @@

361

"nrepl-getcell-match")))

362

(socket-close sock))))))

363

+364

(test-group "nrepl interrupt/abort"

+365

(test "a runaway eval is interrupted from a second connection and the session survives"

+366

(with-server

+367

(lambda (server)

+368

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

+369

(pump server 5)

+370

;; Start a CPU-bound eval that never returns on its own.

+371

(send-request eval-sock

+372

'(request :id "runaway" :op eval :code "(let loop () (loop))"))

+373

;; Drive several slices — the eval keeps yielding, never completes,

+374

;; and (critically) the host loop keeps turning.

+375

(pump server 10)

+376

(assert-false (socket-ready? eval-sock 20)) ; no response yet

+377

;; Interrupt it from a SECOND connection.

+378

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

+379

(pump server 3)

+380

(send-request abort-sock

+381

'(request :id "do-abort" :op abort :target-id "runaway"))

+382

(pump server 10)

+383

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

+384

(eval-resp (read-response eval-sock)))

+385

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

+386

(assert-equal (response-ref abort-resp ':aborted #f) "runaway")

+387

;; The interrupted eval receives a terminal interrupted error.

+388

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

+389

(assert-equal (response-ref eval-resp ':code #f) "interrupted"))

+390

;; Session survives: the same connection evaluates normally after.

+391

(send-request eval-sock

+392

'(request :id "after-abort" :op eval :code "(+ 20 22)"))

+393

(pump server 20)

+394

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

+395

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

+396

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

+397

(socket-close eval-sock)

+398

(socket-close abort-sock))))))

+399

+400

(test "aborting an unknown target reports not-found and leaves running evals alone"

+401

(with-server

+402

(lambda (server)

+403

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

+404

(pump server 5)

+405

(let ((resp (request-response server sock

+406

'(request :id "abort-nobody" :op abort :target-id "ghost"))))

+407

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

+408

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

+409

;; A non-string :target-id must not crash the server loop; it simply

+410

;; matches nothing and reports not-found.

+411

(let ((resp (request-response server sock

+412

'(request :id "abort-badtype" :op abort :target-id 42))))

+413

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

+414

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

+415

;; Server still healthy afterwards.

+416

(let ((resp (request-response server sock

+417

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

+418

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

+419

(socket-close sock))))))

+420

+421

(test-group "nrepl output streaming"

+422

(test "eval output streams as incremental :out frames before the final response"

+423

(with-server

+424

(lambda (server)

+425

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

+426

(conn (make-conn sock)))

+427

(pump server 5)

+428

;; Two displays separated by CPU-bound spins so they land in

+429

;; different slices — proving output is flushed incrementally, not

+430

;; batched at completion.

+431

(send-request sock

+432

'(request :id "stream" :op eval

+433

               :code "(begin (display \"chunk-a\") (let loop ((n 0)) (if (< n 80000) (loop (+ n 1)) #t)) (display \"chunk-b\") (let loop ((n 0)) (if (< n 80000) (loop (+ n 1)) #t)) 42)"))

+434

(pump server 400) ; drive the sliced eval to completion

+435

(let* ((frames (conn-read-until-final conn 32))

+436

(out-frames (frames-with-status frames 'out))

+437

(final (car (reverse frames))))

+438

;; At least one streamed :out frame arrived...

+439

(assert-true (> (length out-frames) 0))

+440

;; ...carrying the original eval request id...

+441

(assert-equal (response-ref (car out-frames) ':id #f) "stream")

+442

;; ...and both displayed chunks were streamed.

+443

(assert-true (any-chunk-contains? out-frames ':out "chunk-a"))

+444

(assert-true (any-chunk-contains? out-frames ':out "chunk-b"))

+445

;; The terminal frame is the eval result, and it comes LAST —

+446

;; every :out frame precedes it on the wire (not batched).

+447

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

+448

(assert-equal (response-ref final ':value #f) "42"))

+449

(socket-close sock)))))

+450

+451

(test "streamed output frames arrive while the eval is still running"

+452

(with-server

+453

(lambda (server)

+454

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

+455

(conn (make-conn sock)))

+456

(pump server 5)

+457

(send-request sock

+458

'(request :id "early" :op eval

+459

:code "(begin (display \"early-out\") (let loop ((n 0)) (if (< n 300000) (loop (+ n 1)) #t)) 99)"))

+460

;; Only a few slices: enough to emit the first display and yield,

+461

;; but NOT enough to finish the long spin.

+462

(pump server 6)

+463

(let ((first (conn-read-frame conn 60)))

+464

;; The first frame is a streamed :out, delivered before any final

+465

;; response exists — the eval is demonstrably still suspended.

+466

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

+467

(assert-equal (response-ref first ':out #f) "early-out"))

+468

;; Now let it finish and collect the terminal result.

+469

(pump server 400)

+470

(let ((rest (conn-read-until-final conn 32)))

+471

(assert-eq (response-ref (car (reverse rest)) ':status #f) 'ok)

+472

(assert-equal (response-ref (car (reverse rest)) ':value #f) "99"))

+473

(socket-close sock))))))

+474

475

(run-tests)