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

rackety, add a test for annotation success on test cases in the stepper

Browse Source
This commit is contained in:
John Clements 2014-04-10 16:05:07 -07:00
parent 784bda15a8
commit 62a001decf
3 changed files with 32 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/htdp-pkgs/htdp-test/tests/stepper/annotation.rkt Normal file
View File

@ -0,0 +1,13 @@
#lang racket/base
(require stepper/private/annotate
"test-engine.rkt"
"language-level-model.rkt")
(define (try-annotating str)
(define expanded
(car (string->expanded-syntax-list intermediate str)))
(printf "expanded: ~s\n" expanded)
(annotate expanded (lambda (a b c) 'bogus) #f))
(try-annotating "(check-expect 2 2)")

10
pkgs/htdp-pkgs/htdp-test/tests/stepper/test-engine.rkt
View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require stepper/private/shared (require stepper/private/shared
stepper/private/model stepper/private/model
@ -9,6 +9,9 @@
"language-level-model.rkt") "language-level-model.rkt")
(provide (contract-out [string->expanded-syntax-list (-> ll-model? string? (listof syntax?))]
[run-one-test (-> symbol? model-or-models/c string? (listof step?) (listof (list/c string? string?)) boolean?)]))
;; A SIMPLE EXAMPLE OF USING THIS FRAMEWORK: ;; A SIMPLE EXAMPLE OF USING THIS FRAMEWORK:
;; note that this example uses the abbreviation from test-abbrev; don't uncomment it! ;; note that this example uses the abbreviation from test-abbrev; don't uncomment it!
@ -77,7 +80,7 @@
;; THE METHOD THAT RUNS A TEST: ;; THE METHOD THAT RUNS A TEST:
(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? ;; 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: ;; the ll-model determines the behavior of the stepper w.r.t. "language-level"-y things:
@ -104,7 +107,8 @@
#f) #f)
#t))) #t)))
(provide/contract [string->expanded-syntax-list (-> ll-model? string? (listof syntax?))])
(define (string->expanded-syntax-list ll-model exp-str) (define (string->expanded-syntax-list ll-model exp-str)
(define expander-thunk ((string->expander-thunk ll-model exp-str))) (define expander-thunk ((string->expander-thunk ll-model exp-str)))
(let loop () (let loop ()

20
pkgs/htdp-pkgs/htdp-test/tests/stepper/through-tests.rkt
View File

@ -5,6 +5,9 @@
"test-engine.rkt" "test-engine.rkt"
"test-cases.rkt" "test-cases.rkt"
;; poor man's testing:
"annotation.rkt"
;; for xml testing: ;; for xml testing:
;; mzlib/class ;; mzlib/class
;; (all-except xml/xml-snipclass snip-class) ;; (all-except xml/xml-snipclass snip-class)
@ -13,6 +16,9 @@
) )
(require stepper/private/annotate)
(provide run-test run-tests run-all-tests run-all-tests-except) (provide run-test run-tests run-all-tests run-all-tests-except)
@ -98,9 +104,8 @@
#;(run-tests '(check-expect forward-ref check-within check-within-bad #;(run-tests '(check-expect forward-ref check-within check-within-bad
check-error check-error-bad)) check-error check-error-bad))
#;(run-tests '(teachpack-universe)) #;(run-tests '(teachpack-universe))
(run-test 'let*-deriv) #;(run-test 'check-expect)
#;(run-test 'letrec1) (run-all-tests)
#;(run-test 'require-test)
#;(string->expanded-syntax-list m:mz "(if true 3 4)" #;(string->expanded-syntax-list m:mz "(if true 3 4)"
#;"(define (a3 x) (if true x x))") #;"(define (a3 x) (if true x x))")
@ -114,8 +119,7 @@
[(_ _ _ [(_ _ _
(_ _ (_ _ (_ _ it) _))) #'it]) (_ _ (_ _ (_ _ it) _))) #'it])
)) ))