suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added tests of require

Browse Source
This commit is contained in:
John Clements 2011-06-28 18:41:16 -07:00
parent b9a802386e
commit 2891869371
3 changed files with 51 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/tests/stepper/test-abbrev.rkt
View File

@ -74,7 +74,8 @@
(list name
ll-models
;printf "exprs = ~s\n args = ~s\n"
(exprs->string `exprs) `(arg ...))))]))
(exprs->string `exprs) `(arg ...)
'())))]))
;; (-> (listof sexp) string?)

31
collects/tests/stepper/test-engine.rkt
View File

@ -77,8 +77,8 @@
;; THE METHOD THAT RUNS A TEST:
(provide/contract [run-one-test (symbol? model-or-models/c string? (listof step?) . -> . boolean?)])
;; run-one-test : symbol? model-or-models? string? steps? -> boolean?
(provide/contract [run-one-test (symbol? model-or-models/c string? (listof step?) (listof (list/c string? string?)) . -> . boolean?)])
;; run-one-test : symbol? model-or-models? string? steps? extra-files -> boolean?
;; the ll-model determines the behavior of the stepper w.r.t. "language-level"-y things:
;; how should values be rendered, should steps be displayed (i.e, will the input & output
@ -90,13 +90,15 @@
;; the steps lists the desired steps. The easiest way to understand these is probably just to
;; read the code for the comparison given in "compare-steps", below.
;; the extra-files contain a list of other files that must occur in the same directory.
;; run the named test, return #t if a failure occurred during the test.
(define (run-one-test name models exp-str expected-steps)
(define (run-one-test name models exp-str expected-steps extra-files)
(unless (display-only-errors)
(printf "running test: ~v\n" name))
(let ([error-has-occurred-box (box #f)])
(test-sequence/many models exp-str expected-steps error-has-occurred-box)
(test-sequence/many models exp-str expected-steps extra-files error-has-occurred-box)
(if (unbox error-has-occurred-box)
(begin (fprintf (current-error-port) "...Error has occurred during test: ~v\n" name)
#f)
@ -109,18 +111,25 @@
;; test-sequence/many : model-or-models/c string? steps? -> (void)
;; run a given test through a bunch of language models (or just one).
(define (test-sequence/many models exp-str expected-steps error-box)
(cond [(list? models)(for-each (lambda (model) (test-sequence model exp-str expected-steps error-box))
(define (test-sequence/many models exp-str expected-steps extra-files error-box)
(cond [(list? models)(for-each (lambda (model) (test-sequence model exp-str expected-steps extra-files error-box))
models)]
[else (test-sequence models exp-str expected-steps error-box)]))
[else (test-sequence models exp-str expected-steps extra-files error-box)]))
;; test-sequence : ll-model? string? steps? -> (void)
;; test-sequence : ll-model? string? steps? extra-files? -> (void)
;; given a language model and an expression and a sequence of steps,
;; check to see whether the stepper produces the desired steps
(define (test-sequence the-ll-model exp-str expected-steps error-box)
(define (test-sequence the-ll-model exp-str expected-steps extra-files error-box)
(match the-ll-model
[(struct ll-model (namespace-spec render-settings enable-testing?))
(let ([filename (build-path test-directory "stepper-test")])
(for ([f (in-list extra-files)])
(define filename (first f))
(define content (second f))
(when (file-exists? filename)
(fprintf (current-error-port) 'run-one-test "file ~s exists, truncating...\n")
(delete-file filename))
(display-to-file content filename))
(call-with-output-file filename
(lambda (port) (fprintf port "~a" exp-str))
#:exists
@ -132,7 +141,9 @@
;; thunk this so that syntax errors happen within the error handlers:
[expanded-thunk
(lambda () (expand-teaching-program port read-syntax namespace-spec '() #f module-id enable-testing?))])
(test-sequence/core render-settings expanded-thunk expected-steps error-box)))]))
(test-sequence/core render-settings expanded-thunk expected-steps error-box))
(for ([f (in-list extra-files)])
(delete-file (first f))))]))
;; test-sequence/core : render-settings? boolean? syntax? steps?
;; this is a front end for calling the stepper's "go"; the main

33
collects/tests/stepper/through-tests.rkt
View File

@ -20,16 +20,30 @@
(define (add-test test)
(match test
[(list name models string expected-steps)
[(list name models string expected-steps extra-files)
(unless (symbol? name)
(error 'add-test "expected name to be a symbol, got: ~e" name))
(unless (or (m:ll-model? models)
(and (list? models) (andmap m:ll-model? models)))
(error 'add-test "expected models to be a list of models, got: ~e" models))
(unless (string? string)
(error 'add-test "expected string to be a string, got: ~e" string))
(unless (list? expected-steps)
(error 'add-test "expected expected-steps to be a list, got: ~e" expected-steps))
(match extra-files
[(list (list (? string? filename) (? string? content)) ...) #t]
[other (error 'add-test
"expected list of extra file specifications, got: ~e"
other)])
(when (assq name list-of-tests)
(error 'add-test "name ~v is already in the list of tests" name))
(set! list-of-tests
(append list-of-tests
(list (list name
(list models string expected-steps)))))]))
(rest test)))))]))
(define (t1 name models string expected-steps)
(add-test (list name models string expected-steps)))
(add-test (list name models string expected-steps '())))
;; one more layer around
(define-syntax (t stx)
@ -2170,11 +2184,20 @@
-> (define (f x) (local ((define-struct a (b c))) x))
{(define-struct a_1 (b c))} {1})
;; test of require
(add-test
(list 'require-test m:upto-int/lam
"(require \"foo.rkt\") (+ a 4)"
'((before-after ((require "foo.rkt") (+ (hilite a) 4))
((require "foo.rkt") (hilite (+ 3 4))))
(before-after ((require "foo.rkt") (hilite (+ 3 4)))
((require "foo.rkt") (hilite 7))))
'(("foo.rkt" "#lang racket \n(provide a) (define a 3)"))))
(provide ggg)
;; run whatever tests are enabled (intended for interactive use):
(define (ggg)
(parameterize ([disable-stepper-error-handling #t]
(parameterize (#;[disable-stepper-error-handling #t]
#;[display-only-errors #t]
#;[store-steps #f]
#;[show-all-steps #t])
@ -2182,5 +2205,5 @@
check-error check-error-bad))
#;(run-tests '(teachpack-universe))
#;(run-all-tests)
(run-tests '(simple-if))
(run-test 'require-test)
))