parent
7b3b27cf0f
commit
220b23630c
|
@ -4,94 +4,24 @@
|
||||||
[repltest-read-syntax read-syntax]
|
[repltest-read-syntax read-syntax]
|
||||||
[repltest-get-info get-info]))
|
[repltest-get-info get-info]))
|
||||||
|
|
||||||
(require syntax/module-reader
|
(require (for-template repltest/private/run-interactions)
|
||||||
racket/syntax
|
racket/syntax
|
||||||
rackunit)
|
repltest/private/util
|
||||||
|
(only-in syntax/module-reader make-meta-reader)
|
||||||
(define (read-pre-prompt in)
|
syntax/strip-context)
|
||||||
(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))))))
|
|
||||||
|
|
||||||
(define ((wrap-reader reader) chr in src line col pos)
|
(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))
|
(reader chr (narrow-until-prompt in) src line col pos))
|
||||||
;; Run interactions:
|
#`(module nm racket
|
||||||
(run-interactions #'(mod nm . body) in)
|
(module code lang . body)
|
||||||
#'(mod nm . 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)
|
(define-values (repltest-read repltest-read-syntax repltest-get-info)
|
||||||
(make-meta-reader
|
(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
|
#lang repltest racket
|
||||||
;; There is a problem if there is a comment before a prompt, as comments aren't
|
;; This file has the name "test", but it shouldn't cause any conflicts in module
|
||||||
;; gobbled-up by the preceeding read.
|
;; names
|
||||||
(define x 0)
|
(define x 0)
|
||||||
(define y 1)
|
|
||||||
'displayed
|
|
||||||
(displayln "displayed too")
|
|
||||||
|
|
||||||
> (+ 1 1)
|
> (+ 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
|
2
|
||||||
|
|
Loading…
Reference in New Issue
Block a user