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

Reorganize, improve, and extend lazy tests.

Browse Source
This commit is contained in:
Eli Barzilay 2011-01-30 13:52:04 -05:00
parent 08d99f4858
commit 6b5e09073a
6 changed files with 131 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/lazy/lazy.rkt
View File

@ -337,7 +337,7 @@
(define* (~vector-set! vec i val) (~ (vector-set! (! vec) (! i) val)))
(define* (~set-box! box val) (~ (set-box! (! box) val)))
;; not much to do with these besides inserting strict points
;; not much to do with these besides inserting strictness points and ~begin
(define-syntax (~cond stx)
(syntax-case stx ()
[(_ [test body ...] ...)
@ -598,6 +598,8 @@
;; --------------------------------------------------------------------------
;; mzlib/list functionality
;; These are a hack, they're not the same due to different error
;; messages (and they work with improper lists too).
(define* (rest x) (~cdr x))
(define* (first x) (~car x))
(define* (second x) (~cadr x))

52
collects/tests/lazy/forcers.rkt Normal file
View File

@ -0,0 +1,52 @@
#lang racket/base
(require tests/eli-tester lazy/force)
(define (test-lazy/force)
(test (! 1) => 1
(! (! 1)) => 1
(! (~ 1)) => 1
(! (~ (~ (~ 1)))) => 1))
(define (test-!list)
(test (!list (list 1 2 3)) => '(1 2 3)
(!list (~ (list 1 2 3))) => '(1 2 3)
(!list (~ (cons 1 (~ (cons 2 (~ (cons 3 (~ null)))))))) => '(1 2 3)
(!list 1) => 1 ; works on dotted lists
(!list (cons 1 2)) => '(1 . 2)))
(define (test-!!list)
(test (!!list (list 1 2 3)) => '(1 2 3)
(!!list (list (~ 1) (~ 2) (~ 3))) => '(1 2 3)
(!!list (list* (~ 1) (~ 2) (~ 3))) => '(1 2 . 3)
(!!list (~ (cons (~ 1) (~ (cons (~ 2) (~ (cons (~ 3) (~ null))))))))
=> '(1 2 3)
(!!list (~ (cons (~ 1) (~ (list 2 3))))) => '(1 2 3)
(!!list (~ (cons (~ 1) (~ (list 2 (~ 3)))))) => '(1 2 3)))
(define (test-!!)
(parameterize ([print-graph #t])
(test
(!! (~ (cons (~ 1) (~ (cons (~ 2) (~ (cons (~ 3) (~ null))))))))
=> '(1 2 3)
(format "~s" (!! (letrec ([ones (~ (cons 1 (~ ones)))]) ones)))
=> "#0=(1 . #0#)"
(format "~s" (!! (letrec ([ones (~ (cons 1 (~ ones)))]) (list ones ones))))
=> "(#0=(1 . #0#) #0#)"
(format "~s" (!! (letrec ([x (vector 1 (~ x))]) x)))
=> "#0=#(1 #0#)"
(format "~s" (!! (letrec ([x (vector-immutable 1 (~ x))]) x)))
=> "#0=#(1 #0#)"
(format "~s" (!! (letrec ([x (box (~ x))]) x)))
=> "#0=#&#0#"
(format "~s" (!! (letrec ([x (box-immutable (~ x))]) x)))
=> "#0=#&#0#"
(format "~s" (!! (letrec ([x (make-prefab-struct 'foo 1 (~ x))]) x)))
=> "#0=#s(foo 1 #0#)")))
(provide forcer-tests)
(define (forcer-tests)
(test do (test-lazy/force)
do (test-!list)
do (test-!!list)
do (test-!!)))

113
collects/tests/lazy/lang.rkt
View File

@ -1,54 +1,75 @@
#lang scheme/base
#lang lazy
(require tests/eli-tester lazy/force)
(require tests/eli-tester)
;; Currently this has only tests for the lazy language `!' forcer.
;; tests for lazy language constructs
(define (test-lazy/force)
(test (! 1) => 1
(! (! 1)) => 1
(! (~ 1)) => 1
(! (~ (~ (~ 1)))) => 1))
(define (basic-tests)
(test
(! ((car (list if)) (< 1 2) 3 (error "poof"))) => 3
(! ((car (list or)) 3 (error "poof"))) => 3
(! ((car (list and)) (< 2 1) (error "poof"))) => #f
(!! (let ([x 0]) (set! x 1) (list x))) => '(1) ; implicit begin forces
(! (let ([x 0]) (when (zero? x) (error "poof")) 1)) =error> "poof"
(! (let ([x 0]) (when (zero? x) (set! x (add1 x)) (set! x (add1 x))) x))
=> 2
(! (let ([x 1]) (unless (zero? x) (set! x (add1 x)) (set! x (add1 x))) x))
=> 3
(! (let ([x 0]) (cond [(zero? x) (set! x (add1 x)) (set! x (add1 x))]) x))
=> 2
(! (eq? 1 1)) => #t
(! (eq? 1 2)) => #f
(! (eqv? 1.0 1.0)) => #t
(! (eqv? 1.0 1)) => #f
(! (= 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
))
(define (test-!list)
(test (!list (list 1 2 3)) => '(1 2 3)
(!list (~ (list 1 2 3))) => '(1 2 3)
(!list (~ (cons 1 (~ (cons 2 (~ (cons 3 (~ null)))))))) => '(1 2 3)
(!list 1) => 1 ; works on dotted lists
(!list (cons 1 2)) => '(1 . 2)))
(define (list-tests)
(test
(! (car 0)) =error> "car: expects argument of type <pair>"
(! (cdr 0)) =error> "cdr: expects argument of type <pair>"
(! (car (cons 1 (/ 1 0)))) => 1
(! (cdr (cons (/ 1 0) 1))) => 1
(! (list-ref (list (/ 1 0) 1 (/ 1 0)) 1)) => 1
(! (list-ref (cons 1 (/ 1 0)) 0)) => 1 ; doesn't force list structure
(! (list-tail (cons (/ 1 0) 0) 1)) => 0
(! (length (list (/ 1 0) (/ 1 0) (/ 1 0)))) => 3
(! (let ([l (list (/ 1 0) (/ 1 0))]) (length (append l l l)))) => 6
(!! (member 1 (cons 0 (cons 1 2)))) => '(1 . 2)
(!! (memq 1 (cons 0 (cons 1 2)))) => '(1 . 2)
(!! (memv 1 (cons 0 (cons 1 2)))) => '(1 . 2)
(! (second (map car (list 1 2 3)))) =error> "expects argument of type"
(! (second (map car (list 1 '(2) 3)))) => 2
))
(define (test-!!list)
(test (!!list (list 1 2 3)) => '(1 2 3)
(!!list (list (~ 1) (~ 2) (~ 3))) => '(1 2 3)
(!!list (list* (~ 1) (~ 2) (~ 3))) => '(1 2 . 3)
(!!list (~ (cons (~ 1) (~ (cons (~ 2) (~ (cons (~ 3) (~ null))))))))
=> '(1 2 3)
(!!list (~ (cons (~ 1) (~ (list 2 3))))) => '(1 2 3)
(!!list (~ (cons (~ 1) (~ (list 2 (~ 3)))))) => '(1 2 3)))
(define (test-!!)
(parameterize ([print-graph #t])
(test
(!! (~ (cons (~ 1) (~ (cons (~ 2) (~ (cons (~ 3) (~ null))))))))
=> '(1 2 3)
(format "~s" (!! (letrec ([ones (~ (cons 1 (~ ones)))]) ones)))
=> "#0=(1 . #0#)"
(format "~s" (!! (letrec ([ones (~ (cons 1 (~ ones)))]) (list ones ones))))
=> "(#0=(1 . #0#) #0#)"
(format "~s" (!! (letrec ([x (vector 1 (~ x))]) x)))
=> "#0=#(1 #0#)"
(format "~s" (!! (letrec ([x (vector-immutable 1 (~ x))]) x)))
=> "#0=#(1 #0#)"
(format "~s" (!! (letrec ([x (box (~ x))]) x)))
=> "#0=#&#0#"
(format "~s" (!! (letrec ([x (box-immutable (~ x))]) x)))
=> "#0=#&#0#"
(format "~s" (!! (letrec ([x (make-prefab-struct 'foo 1 (~ x))]) x)))
=> "#0=#s(foo 1 #0#)")))
(define (take-tests)
(define test-lst1 '(1 2 3))
(test
(! (take "nonnum" test-lst1))
=error>
#rx"take: expects type <non-negative exact integer> as 1st .* '\\(1 2 3\\)"
(! (take -1 test-lst1))
=error> "take: expects type <non-negative exact integer> as 1st argument"
(! (take -1 "nonlist"))
=error> "take: expects type <non-negative exact integer> as 1st argument"
(! (take 0 "nonlist")) => '()
(! (take 1 "nonlist")) =error> "take: not a proper list: \"nonlist\""
(! (take 0 null)) => '()
(! (take 0 test-lst1)) => '()
(!! (take 1 test-lst1)) => '(1)
(!! (take 2 test-lst1)) => '(1 2)
(!! (take 3 (take 4 test-lst1))) => '(1 2 3) ; doesn't force the error
(! (fourth (take 4 test-lst1))) ; this one does
=error> "take: index 4 too large for input list"
(! (list-ref (take (~ 1) (list 2)) 0)) => 2
(! (take 0 (error))) => '() ; doesn't even force the list structure
(!! (take 1 (cons 0 (error "poof")))) => '(0)
))
(provide lang-tests)
(define (lang-tests)
(test do (test-lazy/force)
do (test-!list)
do (test-!!list)
do (test-!!)))
(! (begin (basic-tests)
(list-tests)
(take-tests))))

33
collects/tests/lazy/langimpl.rkt
View File

@ -1,33 +0,0 @@
#lang scheme/base
(require tests/eli-tester lazy)
;; tests for lazy language constructs
;; add tests as needed
(provide test-take)
(define (test-take)
(define test-lst1 '(1 2 3))
(test (! (take "nonnum" test-lst1)) =error> "take: expects type <non-negative exact integer> as 1st argument, given: \"nonnum\"; other arguments were: (1 2 3)"
(! (take -1 test-lst1)) =error> "take: expects type <non-negative exact integer> as 1st argument, given: -1; other arguments were: (1 2 3)"
(! (take -1 "nonlist")) =error> "take: expects type <non-negative exact integer> as 1st argument, given: -1; other arguments were: \"nonlist\""
(! (take 0 "nonlist")) => '() ; this is how Racket's take behaves
(! (take 1 "nonlist")) =error> "take: not a proper list: \"nonlist\""
(! (take 0 null)) => '()
(! (take 0 test-lst1)) => '() ; test for push#22080
(! (car (take 1 test-lst1))) => 1
(! (cdr (take 1 test-lst1))) => '()
(! (first (take 2 test-lst1))) => 1
(! (second (take 2 test-lst1))) => 2
(! (cddr (take 2 test-lst1))) => '()
(! (first (take 4 test-lst1))) => 1
(! (second (take 4 test-lst1))) => 2
(! (third (take 4 test-lst1))) => 3
(! (fourth (take 4 test-lst1))) =error> "take: index 4 too large for input list"
(! (list-ref (take (car (list 1)) (list 2)) 0)) => 2
))
; not working, only get 1 test passed
#;(define (langimpl-tests)
(test (test-take)))

12
collects/tests/lazy/main.rkt
View File

@ -1,9 +1,7 @@
#lang scheme/base
#lang racket/base
(require tests/eli-tester "promise.rkt" "lang.rkt" "langimpl.rkt")
(require tests/eli-tester "promise.rkt" "forcers.rkt" "lang.rkt")
(test do (lang-tests)
; do (langimpl-tests) ; not working, so import test-take directly
do (test-take)
do (promise-tests)
)
(test do (promise-tests)
do (forcer-tests)
do (lang-tests))

6
collects/tests/lazy/promise.rkt
View File

@ -1,6 +1,8 @@
#lang scheme/base
#lang racket/base
(require scheme/promise tests/eli-tester (for-syntax scheme/base))
;; Tests for the various racket promises
(require racket/promise tests/eli-tester (for-syntax racket/base))
;; check that things are `promise?'s or not
(define (test-types)