parent
7b3b27cf0f
commit
220b23630c
|
@ -4,94 +4,24 @@
|
|||
[repltest-read-syntax read-syntax]
|
||||
[repltest-get-info get-info]))
|
||||
|
||||
(require syntax/module-reader
|
||||
(require (for-template repltest/private/run-interactions)
|
||||
racket/syntax
|
||||
rackunit)
|
||||
|
||||
(define (read-pre-prompt in)
|
||||
(regexp-try-match #px"^\\s*" in))
|
||||
|
||||
(define (read-actual-prompt in)
|
||||
(regexp-try-match #px"^> " in))
|
||||
|
||||
(define (peak-prompt in)
|
||||
(regexp-try-match #px"^\\s*> " (peeking-input-port in)))
|
||||
|
||||
(define (skip-newline in)
|
||||
(regexp-try-match #px"^\n" in))
|
||||
|
||||
(define (peek-read-length in)
|
||||
(let* ([pk (peeking-input-port in)]
|
||||
[start (file-position pk)]
|
||||
[r (read pk)]
|
||||
[end (file-position pk)])
|
||||
(- end start)))
|
||||
|
||||
(define (narrow-next-read in)
|
||||
(make-limited-input-port in (peek-read-length in)))
|
||||
|
||||
(define (peak-until-prompt-length in)
|
||||
(let* ([pk (peeking-input-port in)]
|
||||
[start (file-position pk)]
|
||||
[end (let loop ()
|
||||
(let* ([pre (read-pre-prompt pk)]
|
||||
[pos (file-position pk)]
|
||||
[pr (read-actual-prompt pk)])
|
||||
(if (or pr (eof-object? (read pk)))
|
||||
pos
|
||||
(loop))))])
|
||||
(- end start)))
|
||||
|
||||
(define (narrow-until-prompt in)
|
||||
(make-limited-input-port in (peak-until-prompt-length in)))
|
||||
|
||||
(define silent-prompt-read
|
||||
(λ ()
|
||||
;; Default current-prompt-read, without showing
|
||||
;; the prompt
|
||||
(let ([in ((current-get-interaction-input-port))])
|
||||
((current-read-interaction) (object-name in) in))))
|
||||
|
||||
(define (run-interactions mod-stx in-rest)
|
||||
(define/with-syntax (mod nm . body) mod-stx)
|
||||
(let ([ns (make-base-namespace)])
|
||||
(eval mod-stx ns)
|
||||
;; This is a hack because I can't get (module->namespace ''m) to work:
|
||||
(define mod-ns (eval #'(begin (require racket/enter)
|
||||
(enter! 'nm #:dont-re-require-enter)
|
||||
(current-namespace))
|
||||
ns))
|
||||
(let loop ()
|
||||
(let* ([pr (read-actual-prompt in-rest)])
|
||||
(when pr
|
||||
(let* ([narrowed (narrow-next-read in-rest)]
|
||||
[os (open-output-string)]
|
||||
[actual (parameterize
|
||||
([current-prompt-read
|
||||
silent-prompt-read]
|
||||
[current-get-interaction-input-port
|
||||
(λ () narrowed)]
|
||||
[current-namespace mod-ns]
|
||||
[current-output-port os]
|
||||
[current-error-port os]
|
||||
[current-print (λ (v)
|
||||
(unless (void? v)
|
||||
(print v)
|
||||
(newline)))])
|
||||
(read-eval-print-loop)
|
||||
(get-output-string os))]
|
||||
[skip (skip-newline in-rest)]
|
||||
[expected (port->string (narrow-until-prompt in-rest))])
|
||||
(check-equal? actual
|
||||
expected))
|
||||
(loop))))))
|
||||
repltest/private/util
|
||||
(only-in syntax/module-reader make-meta-reader)
|
||||
syntax/strip-context)
|
||||
|
||||
(define ((wrap-reader reader) chr in src line col pos)
|
||||
(define/with-syntax (mod nm . body)
|
||||
(define/with-syntax (mod nm lang . body)
|
||||
(reader chr (narrow-until-prompt in) src line col pos))
|
||||
;; Run interactions:
|
||||
(run-interactions #'(mod nm . body) in)
|
||||
#'(mod nm . body))
|
||||
#`(module nm racket
|
||||
(module code lang . body)
|
||||
(require 'code)
|
||||
(provide (all-from-out 'code))
|
||||
(module test racket/base
|
||||
(require repltest/private/run-interactions)
|
||||
(run-interactions #'(mod nm lang . body)
|
||||
(open-input-string #,(port->string in))
|
||||
(#%variable-reference)))))
|
||||
|
||||
(define-values (repltest-read repltest-read-syntax repltest-get-info)
|
||||
(make-meta-reader
|
||||
|
|
43
private/run-interactions.rkt
Normal file
43
private/run-interactions.rkt
Normal file
|
@ -0,0 +1,43 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide run-interactions)
|
||||
|
||||
(require racket/syntax
|
||||
racket/port
|
||||
rackunit
|
||||
repltest/private/util)
|
||||
|
||||
(define (run-interactions mod-stx in-rest varref)
|
||||
(define/with-syntax (mod nm lang . body) mod-stx)
|
||||
(let ([ns (make-base-namespace)])
|
||||
;; This is a hack because I can't get (module->namespace ''nm) to work:
|
||||
(define res-mod
|
||||
(module-path-index-resolve
|
||||
(module-path-index-join '(submod ".." code)
|
||||
(variable-reference->module-path-index varref))))
|
||||
(dynamic-require res-mod #f)
|
||||
(define mod-ns (module->namespace res-mod))
|
||||
(let loop ()
|
||||
(let* ([pr (read-actual-prompt in-rest)])
|
||||
(when pr
|
||||
(let* ([narrowed (narrow-next-read in-rest)]
|
||||
[os (open-output-string)]
|
||||
[actual (parameterize
|
||||
([current-prompt-read
|
||||
silent-prompt-read]
|
||||
[current-get-interaction-input-port
|
||||
(λ () narrowed)]
|
||||
[current-namespace mod-ns]
|
||||
[current-output-port os]
|
||||
[current-error-port os]
|
||||
[current-print (λ (v)
|
||||
(unless (void? v)
|
||||
(print v)
|
||||
(newline)))])
|
||||
(read-eval-print-loop)
|
||||
(get-output-string os))]
|
||||
[skip (skip-newline in-rest)]
|
||||
[expected (port->string (narrow-until-prompt in-rest))])
|
||||
(check-equal? actual
|
||||
expected))
|
||||
(loop))))))
|
54
private/util.rkt
Normal file
54
private/util.rkt
Normal file
|
@ -0,0 +1,54 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide read-pre-prompt
|
||||
read-actual-prompt
|
||||
skip-newline
|
||||
peek-read-length
|
||||
narrow-next-read
|
||||
peak-until-prompt-length
|
||||
narrow-until-prompt
|
||||
silent-prompt-read)
|
||||
|
||||
(require racket/syntax
|
||||
racket/port)
|
||||
|
||||
(define (read-pre-prompt in)
|
||||
(regexp-try-match #px"^\\s*" in))
|
||||
|
||||
(define (read-actual-prompt in)
|
||||
(regexp-try-match #px"^> " in))
|
||||
|
||||
(define (skip-newline in)
|
||||
(regexp-try-match #px"^\n" in))
|
||||
|
||||
(define (peek-read-length in)
|
||||
(let* ([pk (peeking-input-port in)]
|
||||
[start (file-position pk)]
|
||||
[r (read pk)]
|
||||
[end (file-position pk)])
|
||||
(- end start)))
|
||||
|
||||
(define (narrow-next-read in)
|
||||
(make-limited-input-port in (peek-read-length in)))
|
||||
|
||||
(define (peak-until-prompt-length in)
|
||||
(let* ([pk (peeking-input-port in)]
|
||||
[start (file-position pk)]
|
||||
[end (let loop ()
|
||||
(let* ([pre (read-pre-prompt pk)]
|
||||
[pos (file-position pk)]
|
||||
[pr (read-actual-prompt pk)])
|
||||
(if (or pr (eof-object? (read pk)))
|
||||
pos
|
||||
(loop))))])
|
||||
(- end start)))
|
||||
|
||||
(define (narrow-until-prompt in)
|
||||
(make-limited-input-port in (peak-until-prompt-length in)))
|
||||
|
||||
(define silent-prompt-read
|
||||
(λ ()
|
||||
;; Default current-prompt-read, without showing
|
||||
;; the prompt
|
||||
(let ([in ((current-get-interaction-input-port))])
|
||||
((current-read-interaction) (object-name in) in))))
|
22
test/meta.rkt
Normal file
22
test/meta.rkt
Normal file
|
@ -0,0 +1,22 @@
|
|||
#lang debug repltest typed/racket
|
||||
;; There is a problem if there is a comment before a prompt, as comments aren't
|
||||
;; gobbled-up by the preceeding read.
|
||||
(define x 0)
|
||||
(define (y) #R(- 3 2))
|
||||
'displayed
|
||||
(displayln "displayed too")
|
||||
|
||||
> (+ 1 1)
|
||||
- : Integer [more precisely: Positive-Index]
|
||||
2
|
||||
> x
|
||||
- : Integer [more precisely: Zero]
|
||||
0
|
||||
> (values x (y))
|
||||
(- 3 2) = 1
|
||||
- : (values Integer Integer) [more precisely: (Values Zero Fixnum)]
|
||||
0
|
||||
1
|
||||
> (+ 2 0)
|
||||
- : Integer [more precisely: Positive-Byte]
|
||||
2
|
3
test/simple.rkt
Normal file
3
test/simple.rkt
Normal file
|
@ -0,0 +1,3 @@
|
|||
#lang repltest racket
|
||||
> (+ 1 1)
|
||||
2
|
|
@ -1,22 +1,6 @@
|
|||
#lang debug repltest typed/racket
|
||||
;; There is a problem if there is a comment before a prompt, as comments aren't
|
||||
;; gobbled-up by the preceeding read.
|
||||
#lang repltest racket
|
||||
;; This file has the name "test", but it shouldn't cause any conflicts in module
|
||||
;; names
|
||||
(define x 0)
|
||||
(define y 1)
|
||||
'displayed
|
||||
(displayln "displayed too")
|
||||
|
||||
> (+ 1 1)
|
||||
- : Integer [more precisely: Positive-Index]
|
||||
2
|
||||
> x
|
||||
- : Integer [more precisely: Zero]
|
||||
0
|
||||
> (values x y)
|
||||
- : (values Integer Integer) [more precisely: (Values Zero One)]
|
||||
0
|
||||
1
|
||||
> #R(+ 2 0)
|
||||
(+ 2 0) = 2
|
||||
- : Integer [more precisely: Positive-Byte]
|
||||
2
|
||||
|
|
Loading…
Reference in New Issue
Block a user