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

in lazy: separate values tests; add more tests

Browse Source
This commit is contained in:
Stephen Chang 2014-07-11 18:00:05 -04:00
parent 8f5b5691a4
commit 8f9903ba58
1 changed files with 29 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
pkgs/lazy/tests/lang.rkt
View File

@ -24,14 +24,6 @@
(! (= 1.0 1)) => #t
(! (equal? (list 1.0) (list 1.0))) => #t
(! (letrec ([zs (cons 0 zs)]) (equal? (list zs zs) (list zs zs)))) => #t
(! (let-values ([(x) (values (error "a"))]) 1)) => 1
(! (let-values ([(x y) (values (error "a") (error "b"))]) 1)) => 1
(! (let*-values ([(x0 x1) (values (error "a") (error "b"))] [(y) (values x0)]) 1)) => 1
;(! (letrec ([x y] [y 1]) x)) => 1 ;; <- this does not pass due to variable references not being delayed
(! (letrec ([x (list y)] [y 1]) (car x))) => 1
(! (letrec-values ([(x) (values (list y))] [(y) (values 1)]) (car x))) => 1
(! (letrec-values ([(x0 x1) (values (list y0) (list y1))] [(y0 y1) (values 1 2)])
(+ (car x0) (car x1)))) => 3
))
(define (list-tests)
@ -209,6 +201,33 @@
(! (andmap 1 (/ 1 0))) =error> "/: division by zero"
))
(define (values-tests)
(test
;; Tests from Luke Whittlesey
(! (let-values ([(x) (values (error "a"))]) 1)) => 1
(! (let-values ([(x y) (values (error "a") (error "b"))]) 1)) => 1
(! (let*-values ([(x) (values (error "a"))]) 1)) => 1
(! (let*-values ([(x0 x1) (values (error "a") (error "b"))] [(y) (values x0)]) 1)) => 1
(! (letrec ([x y] [y 1]) x)) =error> "y: undefined"
(! (letrec ([x (list y)] [y 1]) (car x))) => 1
(! (letrec-values ([(x) (values (error "a"))]) 1)) => 1
(! (letrec-values ([(x y) (values (error "a") (error "b"))]) 1)) => 1
(! (letrec-values ([(x) (values (list y))] [(y) (values 1)]) (car x))) => 1
(! (letrec-values ([(x0 x1) (values (list y0) (list y1))] [(y0 y1) (values 1 2)])
(+ (car x0) (car x1)))) => 3
(! (letrec-values ([(A) (values (list 'a B))]
[(B) (values (list 'b A))]) (car A))) => 'a
(! (letrec-values ([(A) (values (list 'a B))]
[(B) (values (list 'b A))]) (caadr A))) => 'b
(! (letrec-values ([(A) (values (list 'a B))]
[(B) (values (list 'b A))]) (car B))) => 'b
(! (letrec-values ([(A) (values (list 'a B))]
[(B) (values (list 'b A))]) (caadr B))) => 'a
;; this errors because let-values (and other values-extractors) must force
;; the rhs (one level down) to extract the values
(let-values ([(x) (error "a")]) 1) =error> "a"
))
(provide lang-tests)
(module+ main (lang-tests))
(define (lang-tests)
@ -217,4 +236,5 @@
(take-tests)
(misc-tests)
(pcps-tests)
(strictness-tests))))
(strictness-tests)
(values-tests))))