Reader and evaluator mostly work. Still need to evaluate the read tests.

.gitignore

@@ -0,0 +1,6 @@
+*~
+\#*
+.\#*
+.DS_Store
+compiled
+/doc/

.travis.yml

@@ -0,0 +1,56 @@
+language: c
+
+# Based from: https://github.com/greghendershott/travis-racket
+
+# Optional: Remove to use Travis CI's older infrastructure.
+sudo: false
+
+env:
+  global:
+    # Supply a global RACKET_DIR environment variable. This is where
+    # Racket will be installed. A good idea is to use ~/racket because
+    # that doesn't require sudo to install and is therefore compatible
+    # with Travis CI's newer container infrastructure.
+    - RACKET_DIR=~/racket
+  matrix:
+    # Supply at least one RACKET_VERSION environment variable. This is
+    # used by the install-racket.sh script (run at before_install,
+    # below) to select the version of Racket to download and install.
+    #
+    # Supply more than one RACKET_VERSION (as in the example below) to
+    # create a Travis-CI build matrix to test against multiple Racket
+    # versions.
+    - RACKET_VERSION=6.0
+    - RACKET_VERSION=6.1
+    - RACKET_VERSION=6.1.1
+    - RACKET_VERSION=6.2
+    - RACKET_VERSION=6.3
+    - RACKET_VERSION=HEAD
+
+matrix:
+  allow_failures:
+    env: RACKET_VERSION=HEAD
+    fast_finish: true
+
+before_install:
+- git clone https://github.com/greghendershott/travis-racket.git
+- cat travis-racket/install-racket.sh | bash # pipe to bash not sh!
+- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us
+
+install:
+
+before_script:
+
+# Here supply steps such as raco make, raco test, etc.  Note that you
+# need to supply /usr/racket/bin/ -- it's not in PATH. You can run
+# `raco pkg install --deps search-auto repltest` to install any required
+# packages without it getting stuck on a confirmation prompt.
+script:
+ - raco pkg install --deps search-auto cover
+ - raco test -x -p repltest
+
+after_success:
+ - raco setup --check-deps repltest
+ - raco pkg install --deps search-auto cover-coveralls
+ - raco pkg install --deps search-auto
+ - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage .

LICENSE.txt

@@ -0,0 +1,11 @@
+repltest
+Copyright (c) 2016 georges
+
+This package is distributed under the GNU Lesser General Public
+License (LGPL).  This means that you can link repltest into proprietary
+applications, provided you follow the rules stated in the LGPL.  You
+can also modify this package; if you distribute a modified version,
+you must distribute it under the terms of the LGPL, which in
+particular means that you must release the source code for the
+modified software.  See http://www.gnu.org/copyleft/lesser.html
+for more information.

README.md

@@ -0,0 +1,4 @@
+REPLtest
+========
+
+This package provides the `#lang repltest` meta-language, which can be used to turn the transcript of an interactive racket session into a series of tests.

info.rkt

@@ -0,0 +1,9 @@
+#lang info
+(define collection "repltest")
+(define deps '("base"
+               "rackunit-lib"))
+(define build-deps '("scribble-lib" "racket-doc"))
+(define scribblings '(("scribblings/repltest.scrbl" ())))
+(define pkg-desc "Copy-paste your REPL interactions, and have them run as tests")
+(define version "0.0")
+(define pkg-authors '(|Georges Dupéron|))

lang/reader.rkt

@@ -0,0 +1,194 @@
+#lang racket
+
+(provide (rename-out [repltest-read read]
+                     [repltest-read-syntax read-syntax]
+                     [repltest-get-info get-info]))
+
+(require syntax/module-reader)
+
+#;(define (repltest-read in)
+    (syntax->datum
+     (repltest-read-syntax #f in)))
+
+(define (read-prompt in)
+  (regexp-try-match #px"^\\s*[0-9]> " in))
+
+(define (read-user-input reader args)
+  (apply reader args))
+
+(define (read-output-values reader args in)
+  (if (read-prompt in)
+      '()
+      (let ([rs (apply reader args)])
+        (if (eof-object? rs)
+            '()
+            (read-output-values reader args in)))))
+
+#;(let ([is (open-input-string "(+ 1 1) 'aaa")]
+        [os (open-output-string)])
+    (parameterize ([current-get-interaction-input-port
+                    (λ () is)]
+                   [current-namespace (make-base-namespace)]
+                   [current-output-port os]
+                   [current-error-port os]
+                   [current-print (λ (v)
+                                    (unless (void? v)
+                                      (print v)
+                                      (newline)))])
+      (read-eval-print-loop))
+    
+    (display (get-output-string os)))
+
+
+
+#;(define-values (wrap-read wrap-read-syntax)
+    (let ()
+      (define (wrap default-reader reader src in . args)
+        ;(displayln (apply default-reader args))
+        ;((λ (x) (displayln x) x) (apply reader args))
+        (displayln args)
+        ((λ (x) (displayln x) x)
+         (apply reader src in (cddr args)));;TODO: not cddr for read
+        #;#`(module m typed/racket
+              '#,(default-reader src in))
+        #;(let* ([in (if (null? (cdr args)) (car args) (cadr args))]
+                 [maybe-prompt (read-prompt in)])
+            (if maybe-prompt
+                ((λ (x) (displayln x) x) (apply reader args))
+                ((λ (x) (displayln x) x) (apply reader args))))
+        #;(let* ([in (if (null? (cdr args)) (car args) (cadr args))]
+                 [first-prompt (read-prompt in)]
+                 [user-input (read-user-input reader args)]
+                 [output-values (read-output-values reader args in)])
+            (if first-prompt
+                #`(module anything racket
+                    '(check-equal? #,user-input
+                                   (values . #,output-values))
+                    (let ([os (open-output-string)])
+                      (parameterize ([current-input-port (open-input-string "")]
+                                     [current-output-port os])
+                        'todo
+                        (get-output-string os))))
+                #'(module anything racket #f))))
+      (values (λ (reader)
+                (λ args
+                  (apply wrap read reader #f (car args) args)))
+              (λ (reader)
+                (λ args
+                  (apply wrap
+                         read-syntax
+                         reader
+                         (car args)
+                         (cadr args)
+                         args))))))
+
+(define (read-one-interaction src in)
+  (let ([prompt (read-prompt in)])
+    (if (not prompt)
+        (values eof #f '())
+        (let ([user-input (read-syntax src in)]
+              [output-values (let loop ()
+                               (if (read-prompt (peeking-input-port in))
+                                   '()
+                                   (let ([val (read-syntax src in)])
+                                     (if (eof-object? val)
+                                         '()
+                                         (cons val (loop))))))])
+          (if (eof-object? user-input)
+              (values (car prompt) #f '())
+              (values (car prompt) user-input output-values))))))
+
+(define ((wrap-reader reader) chr in src line col pos)
+  (let* ([pk (peeking-input-port in)]
+         [start (file-position pk)]
+         [end (let loop ()
+                (let* ([pos (file-position pk)]
+                       [pr (read-prompt pk)])
+                  (if (or pr (eof-object? (read pk)))
+                      pos
+                      (loop))))])
+    (with-syntax ([(mod nm . body)
+                   (reader chr
+                           (make-limited-input-port in (- end start))
+                           src line col pos)])
+      (let loop ()
+        (let-values ([(p u o) (read-one-interaction src in)])
+          (when u
+            ;(display p)
+            ;(displayln (syntax->datum u))
+            ;(map displayln (map syntax->datum o))
+            (loop))))
+      ;; Run interactions:
+      (let ([is (open-input-string "x y (number->string (+ 1 1))")]
+            [os (open-output-string)]
+            [ns (make-base-namespace)])
+        (eval #'(mod nm . body) 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))
+        (parameterize ([current-get-interaction-input-port
+                        (λ () is)]
+                       [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))
+        
+        (display (get-output-string os)))
+      #'(mod nm racket) #;#'(mod nm . body))))
+
+(define-values (repltest-read repltest-read-syntax repltest-get-info)
+  (make-meta-reader
+   'repltest
+   "language path"
+   (lambda (bstr)
+     (let* ([str (bytes->string/latin-1 bstr)]
+            [sym (string->symbol str)])
+       (and (module-path? sym)
+            (vector
+             ;; try submod first:
+             `(submod ,sym reader)
+             ;; fall back to /lang/reader:
+             (string->symbol (string-append str "/lang/reader"))))))
+   (λ (read) read)
+   wrap-reader;wrap-read-syntax
+   (lambda (proc)
+     (lambda (key defval)
+       (define (fallback) (if proc (proc key defval) defval))
+       (case key
+         [else (fallback)])))))
+
+
+#|
+#lang racket
+(let ([is (open-input-string "x y (number->string (+ 1 1))")]
+      [os (open-output-string)]
+      [ns (make-base-namespace)])
+  (eval #'(module m typed/racket
+            (define x 0)
+            (define y 1)
+            'displayed
+            (displayln "aaaa"))
+        ns)
+  (define mod-ns (eval #'(begin (require racket/enter)
+                                (enter! 'm #:dont-re-require-enter)
+                                (current-namespace))
+                       ns))
+  (parameterize ([current-get-interaction-input-port
+                  (λ () is)]
+                 [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))
+  
+  (display (get-output-string os)))
+|#

main.rkt

@@ -0,0 +1,35 @@
+#lang racket/base
+
+(module+ test
+  (require rackunit))
+
+;; Notice
+;; To install (from within the package directory):
+;;   $ raco pkg install
+;; To install (once uploaded to pkgs.racket-lang.org):
+;;   $ raco pkg install <<name>>
+;; To uninstall:
+;;   $ raco pkg remove <<name>>
+;; To view documentation:
+;;   $ raco doc <<name>>
+;;
+;; For your convenience, we have included a LICENSE.txt file, which links to
+;; the GNU Lesser General Public License.
+;; If you would prefer to use a different license, replace LICENSE.txt with the
+;; desired license.
+;;
+;; Some users like to add a `private/` directory, place auxiliary files there,
+;; and require them in `main.rkt`.
+;;
+;; See the current version of the racket style guide here:
+;; http://docs.racket-lang.org/style/index.html
+
+;; Code here
+
+(module+ test
+  ;; Tests to be run with raco test
+  )
+
+(module+ main
+  ;; Main entry point, executed when run with the `racket` executable or DrRacket.
+  )

scribblings/repltest.scrbl

@@ -0,0 +1,17 @@
+#lang scribble/manual
+@require[@for-label[repltest
+                    racket/base]]
+
+@title{REPL test: copy-paste REPL interactions to define tests}
+@author{georges}
+
+@defmodule[repltest]
+
+This package define a meta-language which parses a REPL
+trace, and re-evaluates it, checking that the outputs
+haven't changed.
+
+This allows to quickly write preliminary unit tests based on
+a debugging session. It is obviously not a substitute for
+writing real tests, and these tests are more prone to the
+“copy-pasted bogus output into the tests” problem.

test/test.rkt

@@ -0,0 +1,25 @@
+#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 1)
+'displayed
+(displayln "displayed too")
+
+1> (+ 1 1)
+2
+2> x
+0
+
+3> (values x y)
+0
+1
+4> #R(+ 2 0)
+(+ 2 0) = 2
+2
+
+#|
+(values (+ 1 1) 4)
+#R(+ 2 0)
+4
+|#