commit a9d3bf1be98f38be1b54caa1975b11843646c7a6
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Wed, 30 Mar 2016 16:21:14 +0200
Reader and evaluator mostly work. Still need to evaluate the read tests.
Diffstat:
9 files changed, 361 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1,6 @@
+*~
+\#*
+.\#*
+.DS_Store
+compiled
+/doc/
+\ No newline at end of file
diff --git a/.travis.yml b/.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 .
diff --git a/LICENSE.txt b/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.
diff --git a/README.md b/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.
+\ No newline at end of file
diff --git a/info.rkt b/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|))
diff --git a/lang/reader.rkt b/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)))
+|#
+\ No newline at end of file
diff --git a/main.rkt b/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.
+ )
diff --git a/scribblings/repltest.scrbl b/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.
diff --git a/test/test.rkt b/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
+|#
+\ No newline at end of file
