36a0fea0cc
Not too much, but already tests large parts of sensitive code. Caught a
bug where ,top would use (enter! #f) but enter grabbed the wrong
namespace since it was instantiated in the wrong namespace.
(cherry picked from commit f5e53de4d9)
95 lines
3.3 KiB
Racket
95 lines
3.3 KiB
Racket
#lang at-exp racket/base
|
|
|
|
(define verbose? (make-parameter #t))
|
|
|
|
(define global-ns (current-namespace))
|
|
|
|
(define stderr (current-error-port))
|
|
|
|
(define (test-xrepl . args)
|
|
(define show-all? (verbose?))
|
|
(define-values [Ii Io] (make-pipe))
|
|
(define-values [Oi Oo] (make-pipe))
|
|
(define repl-thread
|
|
(parameterize ([current-input-port Ii]
|
|
[current-output-port Oo]
|
|
[current-error-port Oo]
|
|
[current-namespace (make-empty-namespace)]
|
|
[error-print-context-length 0] ; easier output
|
|
[exit-handler (λ (_) (kill-thread repl-thread))])
|
|
(thread (λ ()
|
|
(namespace-attach-module global-ns 'racket/base)
|
|
(namespace-require 'racket)
|
|
(dynamic-require 'xrepl #f)
|
|
(read-eval-print-loop)))))
|
|
(define (repl-> expected)
|
|
(define output (read-string (string-length expected) Oi))
|
|
(if (equal? output expected)
|
|
(when show-all? (display output))
|
|
(error 'xrepl "test failure, expected ~s, got ~s" expected output)))
|
|
(let loop ([strs args] [input? #f])
|
|
(cond
|
|
[(and (pair? strs) (equal? "" (car strs)))
|
|
(loop (cdr strs) input?)]
|
|
[(and (thread-dead? repl-thread) (null? strs))
|
|
(printf "All tests passed.\n")]
|
|
[(thread-dead? repl-thread)
|
|
(error 'xrepl "test failure, repl thread died unexpectedly")]
|
|
[(null? strs)
|
|
(if (sync/timeout 1 repl-thread)
|
|
(loop strs input?)
|
|
(error 'xrepl "test failure, repl thread is alive at end of tests"))]
|
|
[(eq? '« (car strs))
|
|
(when input? (error 'xrepl "bad test: unterminated `«'"))
|
|
(loop (cdr strs) #t)]
|
|
[(eq? '» (car strs))
|
|
(unless input? (error 'xrepl "bad test: redundant `»'"))
|
|
(loop (cdr strs) 'newline)]
|
|
[(regexp-match #rx"^(.*?)(?: *⇒[^\n]*)(.*)" (car strs))
|
|
=> (λ (m) (loop (list* (cadr m) (caddr m) (cdr strs)) input?))]
|
|
[(regexp-match #rx"^(.*?)([«»])(.*)" (car strs))
|
|
=> (λ (m) (loop (list* (cadr m) (string->symbol (caddr m)) (cadddr m)
|
|
(cdr strs))
|
|
input?))]
|
|
[(eq? 'newline input?)
|
|
(unless (regexp-match? #rx"^\n" (car strs))
|
|
(error 'xrepl "bad test: `»' followed by a non-newline"))
|
|
(newline Io) (flush-output Io)
|
|
(when show-all? (newline) (flush-output))
|
|
(loop (cons (substring (car strs) 1) (cdr strs)) #f)]
|
|
[input?
|
|
(display (car strs) Io)
|
|
(when show-all? (display (car strs)) (flush-output))
|
|
(loop (cdr strs) #t)]
|
|
[else
|
|
(repl-> (car strs))
|
|
(loop (cdr strs) #f)])))
|
|
|
|
@test-xrepl|={
|
|
-> «(- 2 1)»
|
|
1
|
|
-> «(values 2 3)»
|
|
2
|
|
3
|
|
-> «(values 4)»
|
|
4
|
|
-> «(list ^ ^^ ^^^ ^^^^)»
|
|
'(4 3 2 1)
|
|
-> «(module foo racket (define x 123))»
|
|
-> «,en foo»
|
|
'foo> «x»
|
|
123
|
|
'foo> «,top»
|
|
-> «(define enter! 123)»
|
|
-> «(enter! 'foo)»
|
|
procedure application: expected procedure, given: 123; arguments were: 'foo
|
|
-> «,en foo» ⇒ but this still works
|
|
'foo> «,top»
|
|
-> «,switch foo»
|
|
; *** Initializing a new `foo' namespace with "racket/main.rkt" ***
|
|
; *** Switching to the `foo' namespace ***
|
|
foo::-> «,switch *»
|
|
; *** Switching to the `*' namespace ***
|
|
-> «,ex»
|
|
|=@||}=|
|