www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

run-interactions.rkt (1704B)


      1 #lang racket/base
      2 
      3 (provide run-interactions
      4          run-interactions2)
      5 
      6 (require racket/syntax
      7          racket/port
      8          rackunit
      9          repltest/private/util)
     10 
     11 (define-syntax-rule (run-interactions in-rest varref)
     12   (begin
     13     (require (prefix-in "main-mod:" (submod "..")))
     14     (define res-mod
     15       (module-path-index-resolve
     16        (module-path-index-join '(submod "..")
     17                                (variable-reference->module-path-index varref))))
     18     (define mod-ns (module->namespace res-mod))
     19     (run-interactions2 in-rest mod-ns)))
     20 
     21 (define (run-interactions2 in-rest mod-ns)
     22   (let loop ()
     23     (let* ([pr (read-actual-prompt in-rest)])
     24       (when pr
     25         (let* ([narrowed (narrow-next-read in-rest)]
     26                [os (open-output-string)]
     27                [actual (parameterize
     28                            ([current-prompt-read
     29                              silent-prompt-read]
     30                             [current-get-interaction-input-port
     31                              (λ () narrowed)]
     32                             [current-namespace mod-ns]
     33                             [current-output-port os]
     34                             [current-error-port os]
     35                             [current-print (λ (v)
     36                                              (unless (void? v)
     37                                                (print v)
     38                                                (newline)))])
     39                          (read-eval-print-loop)
     40                          (get-output-string os))]
     41                [skip (skip-newline in-rest)]
     42                [expected (port->string (narrow-until-prompt in-rest))])
     43           (check-equal? actual
     44                         expected))
     45         (loop)))))