From a9d3bf1be98f38be1b54caa1975b11843646c7a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Wed, 30 Mar 2016 16:21:14 +0200 Subject: [PATCH] Reader and evaluator mostly work. Still need to evaluate the read tests. --- .gitignore | 6 ++ .travis.yml | 56 +++++++++++ LICENSE.txt | 11 +++ README.md | 4 + info.rkt | 9 ++ lang/reader.rkt | 194 +++++++++++++++++++++++++++++++++++++ main.rkt | 35 +++++++ scribblings/repltest.scrbl | 17 ++++ test/test.rkt | 25 +++++ 9 files changed, 357 insertions(+) create mode 100644 .gitignore create mode 100644 .travis.yml create mode 100644 LICENSE.txt create mode 100644 README.md create mode 100644 info.rkt create mode 100644 lang/reader.rkt create mode 100644 main.rkt create mode 100644 scribblings/repltest.scrbl create mode 100644 test/test.rkt diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..adfb974 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +*~ +\#* +.\#* +.DS_Store +compiled +/doc/ \ No newline at end of file diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..58327d1 --- /dev/null +++ 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 new file mode 100644 index 0000000..e022ad6 --- /dev/null +++ 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 new file mode 100644 index 0000000..b678edc --- /dev/null +++ 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 new file mode 100644 index 0000000..24bcc0a --- /dev/null +++ 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 new file mode 100644 index 0000000..740541b --- /dev/null +++ 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 new file mode 100644 index 0000000..8911344 --- /dev/null +++ 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 <> +;; To uninstall: +;; $ raco pkg remove <> +;; To view documentation: +;; $ raco doc <> +;; +;; 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 new file mode 100644 index 0000000..54be906 --- /dev/null +++ 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 new file mode 100644 index 0000000..fef92cd --- /dev/null +++ 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