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

Improving PLAI testing

Browse Source
This commit is contained in:
Jay McCarthy 2010-08-19 10:00:36 -06:00
parent 101026292c
commit 6f272d2e6a
3 changed files with 211 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/tests/plai/datatype.rkt
View File

@ -1,4 +1,6 @@
#lang plai #lang plai
(require (prefix-in eli: tests/eli-tester))
(define-type A (define-type A
[mta] [mta]
[a (b B?)]) [a (b B?)])
@ -10,17 +12,9 @@
(define-type T (define-type T
[i (f number?)]) [i (f number?)])
(i 4)
(test/exn (make-i #f) "contract")
(test/exn (i-f #f) "contract")
(define-type T1 (define-type T1
[i1 (f (car 1))]) [i1 (f (car 1))])
(type-case A (mta)
[mta () 1]
[a (x) 2])
(define-type DefrdSub (define-type DefrdSub
[mtSub] [mtSub]
[aSub (value boolean?)]) [aSub (value boolean?)])
@ -31,9 +25,31 @@
[aSub (a-name) 2])) [aSub (a-name) 2]))
(define-type t (c)) (define-type t (c))
(test/exn
(type-case t (list 1) (c () 1))
"expected")
(define-type t1 (c1 (n number?))) (define-type t1 (c1 (n number?)))
(test (c1 'not-a-number) (list 5))
(eli:test
(i 4)
(regexp-match "\\(exception \\(make-i #f\\) \".+/collects/tests/plai/datatype\\.rkt:13\\.3: use broke the contract \\(-> number\\? i\\?\\) on make-i given to \\\\n \\(file\\\\n .+/collects/tests/plai/datatype\\.rkt\\)\\\\n; expected <number\\?>, given: #f\" <no-expected-value> \"at line 36\"\\)"
(with-output-to-string (λ () (test/exn (make-i #f) "contract"))))
(regexp-match "\\(exception \\(i-f #f\\) \".+/collects/tests/plai/datatype\\.rkt:13\\.6: use broke the contract \\(-> i\\? number\\?\\) on i-f given to \\\\n \\(file\\\\n .+/collects/tests/plai/datatype\\.rkt\\)\\\\n; expected <i\\?>, given: #f\" <no-expected-value> \"at line 39\"\\)"
(with-output-to-string (λ () (test/exn (i-f #f) "contract"))))
(type-case A (mta)
[mta () 1]
[a (x) 2])
=>
1
(regexp-match "\\(exception \\(c1 \\(quote not-a-number\\)\\) \".+/collects/tests/plai/datatype\\.rkt:29\\.17: use broke the contract \\(-> number\\? c1\\?\\) on c1 given to \\\\n \\(file\\\\n .+/plt/collects/tests/plai/datatype\\.rkt\\)\\\\n; expected <number\\?>, given: 'not-a-number\" <no-expected-value> \"at line 49\"\\)"
(with-output-to-string (λ () (test (c1 'not-a-number) (list 5)))))
(regexp-match (regexp-quote "(exception (type-case t (list 1) (c () 1)) \"type-case: expected a value from type t, got: (1)\" <no-expected-value> \"at line 53\")")
(with-output-to-string (λ ()
(test/exn
(type-case t (list 1) (c () 1))
"expected")))))

7
collects/tests/plai/printer.rkt
View File

@ -11,8 +11,11 @@
(print v s) (print v s)
(get-output-string s))) (get-output-string s)))
(define success 0)
(define (check a b) (define (check a b)
(unless (equal? a b) (error 'check "failed: ~s vs. ~s" a b))) (if (equal? a b)
(set! success (add1 success))
(error 'check "failed: ~s vs. ~s" a b)))
(check (to-string print (bar "a" 'b)) "(bar \"a\" 'b)") (check (to-string print (bar "a" 'b)) "(bar \"a\" 'b)")
(check (to-string write (bar "a" 'b)) "#(struct:bar \"a\" b)") (check (to-string write (bar "a" 'b)) "#(struct:bar \"a\" b)")
@ -21,3 +24,5 @@
(check (to-string print (list (bar "a" (list 'b)))) "(list (bar \"a\" '(b)))") (check (to-string print (list (bar "a" (list 'b)))) "(list (bar \"a\" '(b)))")
(check (to-string write (list (bar "a" (list 'b)))) "(#(struct:bar \"a\" (b)))") (check (to-string write (list (bar "a" (list 'b)))) "(#(struct:bar \"a\" (b)))")
(check (to-string display (list (bar "a" (list 'b)))) "(#(struct:bar a (b)))") (check (to-string display (list (bar "a" (list 'b)))) "(#(struct:bar a (b)))")
(printf "~a tests passed.\n" success)

209
collects/tests/plai/test-harness.rkt
View File

@ -1,44 +1,185 @@
#lang plai #lang plai
(require (prefix-in eli: tests/eli-tester))
(define-type WAE (define-type WAE
[num (n number?)] [num (n number?)]
[id (s symbol?)]) [id (s symbol?)])
(define (go) (define-syntax-rule (->string e)
(test (num 5) (id 'x)) (regexp-replace "line [0-9]+" (with-output-to-string (λ () e)) "line ??"))
(test 1 (+ 1 0)) (define (go catch? errors? abridged?)
(test 1 1) (eli:test
(test 1 2) #:failure-prefix (format "~a / ~a / ~a" catch? errors? abridged?)
(test (/ 1 0) 0) (eli:test
(test (error "zamboni") 347)
(test 3.4 3.4000001)
(test +inf.0 +inf.0)
(test/pred 0 zero?)
(test/pred 1 zero?)
(test/pred 1 (error 'pred))
(test/pred 1 (lambda (n) (/ 1 0)))
(test/pred "a" string->number)
(test/exn (error "zamboni") "zamboni")
(test/exn (error "samboni") "zamboni")
(test/exn 5 "zamboni")
(test/exn (/ 1 0) "division")
(test/regexp (error "zamboni") "zam")
(test/regexp (error "samboni") "zam")
(test/regexp 5 "zam")
(test/regexp (/ 1 0) "divis")
)
(for ([catch? (in-list (list #t #f))])
(plai-catch-test-exn catch?) (plai-catch-test-exn catch?)
(for ([errors? (in-list (list #t #f))])
(print-only-errors errors?) (print-only-errors errors?)
(for ([abridged? (in-list (list #t #f))])
(abridged-test-output abridged?) (abridged-test-output abridged?)
(with-handlers ([exn? (lambda (x) (printf "~S~n" x))])
(go)) (->string (test (num 5) (id 'x)))
(newline)))) =>
(if abridged?
"(bad #(struct:num 5) #(struct:id x))\n"
"(bad (num 5) #(struct:num 5) #(struct:id x) \"at line ??\")\n")
(->string (test 1 (+ 1 0)))
=>
(if errors?
""
(if abridged?
"(good 1 1)\n"
"(good 1 1 1 \"at line ??\")\n"))
(->string (test 1 1))
=>
(if errors?
""
(if abridged?
"(good 1 1)\n"
"(good 1 1 1 \"at line ??\")\n"))
(->string (test 1 2))
=>
(if abridged?
"(bad 1 2)\n"
"(bad 1 1 2 \"at line ??\")\n")
(->string (test (/ 1 0) 0))
=>
(if catch?
(if abridged?
"(exception \"/: division by zero\" <no-expected-value>)\n"
"(exception (/ 1 0) \"/: division by zero\" <no-expected-value> \"at line ??\")\n")
(error '/ "division by zero"))
(->string (test (error "zamboni") 347))
=>
(if catch?
(if abridged?
"(exception \"zamboni\" 347)\n"
"(exception (error \"zamboni\") \"zamboni\" 347 \"at line ??\")\n")
(error "zamboni"))
(->string (test 3.4 3.4000001))
=>
(if errors?
""
(if abridged?
"(good 3.4 3.4000001)\n"
"(good 3.4 3.4 3.4000001 \"at line ??\")\n"))
(->string (test +inf.0 +inf.0))
=>
(if errors?
""
(if abridged?
"(good +inf.0 +inf.0)\n"
"(good +inf.0 +inf.0 +inf.0 \"at line ??\")\n"))
(->string (test/pred 0 zero?))
=>
(if errors?
""
(if abridged?
"(good 0 zero?)\n"
"(good 0 0 zero? \"at line ??\")\n"))
(->string (test/pred 1 zero?))
=>
(if abridged?
"(bad 1 zero?)\n"
"(bad 1 1 zero? \"at line ??\")\n")
(->string (test/pred 1 (error 'pred)))
=>
(if catch?
(if abridged?
"(pred-exception \"error: pred\" <no-expected-value>)\n"
"(pred-exception 1 \"error: pred\" <no-expected-value> \"at line ??\")\n")
(error 'pred))
(->string (test/pred 1 (lambda (n) (/ 1 0))))
=>
(if catch?
(if abridged?
"(pred-exception \"/: division by zero\" <no-expected-value>)\n"
"(pred-exception 1 \"/: division by zero\" <no-expected-value> \"at line ??\")\n")
(error '/ "division by zero"))
(->string (test/pred "a" string->number))
=>
(if abridged?
"(bad \"a\" string->number)\n"
"(bad \"a\" \"a\" string->number \"at line ??\")\n")
(->string (test/exn (error "zamboni") "zamboni"))
=>
(if catch?
(if errors?
""
(if abridged?
"(good \"zamboni\" \"zamboni\")\n"
"(good (error \"zamboni\") \"zamboni\" \"zamboni\" \"at line ??\")\n"))
(error "zamboni"))
(->string (test/exn (error "samboni") "zamboni"))
=>
(if catch?
(if abridged?
"(bad \"samboni\" \"zamboni\")\n"
"(bad (error \"samboni\") \"samboni\" \"zamboni\" \"at line ??\")\n")
(error "samboni"))
(->string (test/exn 5 "zamboni"))
=>
(if abridged?
"(bad 5 \"zamboni\")\n"
"(bad 5 5 \"zamboni\" \"at line ??\")\n")
(->string (test/exn (/ 1 0) "division"))
=>
(if catch?
(if abridged?
"(exception \"/: division by zero\" <no-expected-value>)\n"
"(exception (/ 1 0) \"/: division by zero\" <no-expected-value> \"at line ??\")\n")
(error '/ "division by zero"))
(->string (test/regexp (error "zamboni") "zam"))
=>
(if catch?
(if errors?
""
(if abridged?
"(good \"zamboni\" \"zam\")\n"
"(good (error \"zamboni\") \"zamboni\" \"zam\" \"at line ??\")\n"))
(error "zamboni"))
(->string (test/regexp (error "samboni") "zam"))
=>
(if catch?
(if abridged?
"(bad \"samboni\" \"zam\")\n"
"(bad (error \"samboni\") \"samboni\" \"zam\" \"at line ??\")\n")
(error "samboni"))
(->string (test/regexp 5 "zam"))
=>
(if abridged?
"(bad 5 \"zam\")\n"
"(bad 5 5 \"zam\" \"at line ??\")\n")
(->string (test/regexp (/ 1 0) "divis"))
=>
(if catch?
(if abridged?
"(exception \"/: division by zero\" <no-expected-value>)\n"
"(exception (/ 1 0) \"/: division by zero\" <no-expected-value> \"at line ??\")\n")
(error '/ "division by zero"))
)))
(eli:test
(for* ([catch? (in-list (list #t #f))]
[errors? (in-list (list #t #f))]
[abridged? (in-list (list #t #f))])
(go catch? errors? abridged?)))