racket/collects/tests/mzscheme/function.ss
2008-03-21 17:55:29 +00:00

110 lines
3.5 KiB
Scheme

(load-relative "loadtest.ss")
(Section 'function)
(require scheme/function mzlib/etc)
;; stuff from scheme/base
(test 0 (compose add1 sub1) 0)
(test 2 (compose add1 (lambda () 1)))
(test 5 (compose (lambda (a b) a) (lambda (x) (values (add1 x) x))) 4)
(test -1 (compose (lambda (a b) (+ a b)) (lambda (x y) (values (- y) x))) 2 3)
(test 'hi (compose (case-lambda [(x) 'bye][(y z) 'hi]) (lambda () (values 1 2))))
(test 'ok (compose (lambda () 'ok) (lambda () (values))))
(test 'ok (compose (lambda () 'ok) (lambda (w) (values))) 5)
(test-values '(1 2 3) (lambda () ((compose (lambda (x) (values x (add1 x) (+ x 2))) (lambda (y) y)) 1)))
(err/rt-test (compose 5))
(err/rt-test (compose add1 sub1 5))
(err/rt-test (compose add1 5 sub1))
(err/rt-test (compose 5 add1 sub1))
(err/rt-test ((compose add1 (lambda () (values 1 2)))) exn:application:arity?)
(err/rt-test ((compose add1 sub1)) exn:application:arity?)
(err/rt-test ((compose (lambda () 1) add1) 8) exn:application:arity?)
(arity-test compose 1 -1)
;; ---------- rec (from mzlib/etc) ----------
(let ()
(test 3 (rec f (λ (x) 3)) 3)
(test 3 (rec f (λ (x) x)) 3)
(test 2 (rec f (λ (x) (if (= x 3) (f 2) x))) 3)
(test 3 (rec (f x) 3) 3)
(test 3 (rec (f x) x) 3)
(test 2 (rec (f x) (if (= x 3) (f 2) x)) 3)
(test 2 (rec (f x . y) (car y)) 1 2 3)
(test 2 'no-duplications
(let ([x 1]) (rec ignored (begin (set! x (+ x 1)) void)) x))
(test 'f object-name (rec (f x) x))
(test 'f object-name (rec (f x . y) x))
(test 'f object-name (rec f (lambda (x) x)))
(test (list 2) (rec (f . x) (if (= (car x) 3) (f 2) x)) 3))
;; ---------- negate ----------
(let ()
(define *not (negate not))
(define *void (negate void))
(define *< (negate <))
(test #t *not #t)
(test #f *not #f)
(test #t *not 12)
(test #f *void)
(test #t *< 12 3)
(test #t *< 12 12)
(test #f *< 11 12)
(test #t *< 14 13 12 11)
(test #f *< 11 12 13 14))
;; ---------- curry/r ----------
(let ()
(define foo0 (lambda () 0))
(define foo1 (lambda (x) x))
(define foo3 (lambda (x y z) (list x y z)))
(define foo2< (lambda (x y . r) (list* x y r)))
(define foo35 (case-lambda [(a b c) 3] [(a b c d e) 5]))
(define foo:x (lambda (#:x [x 1] n . ns) (* x (apply + n ns))))
(define *foo0 (curry foo0))
(define *foo1 (curry foo1))
(define *foo3 (curry foo3))
(define *foo2< (curry foo2<))
(define *foo35 (curry foo35))
(define *foo:x2 (curry foo:x #:x 2))
(define ++ (curry +))
(define-syntax-rule ((f x ...) . => . e2) (test e2 f x ...))
;; see the docs for why these are expected
(((curry foo0)) . => . 0)
((*foo0) . => . 0)
((curry foo1 123) . => . 123)
((*foo1 123) . => . 123)
(((*foo1) 123) . => . 123)
((((*foo1)) 123) . => . 123)
((curry foo3 1 2 3) . => . '(1 2 3))
((*foo3 1 2 3) . => . '(1 2 3))
(((*foo3 1 2) 3) . => . '(1 2 3))
(((((((*foo3) 1)) 2)) 3) . => . '(1 2 3))
(((curry foo2< 1 2)) . => . '(1 2))
(((curry foo2< 1 2 3)) . => . '(1 2 3))
(((curry foo2< 1 2) 3) . => . '(1 2 3))
(((*foo2< 1 2)) . => . '(1 2))
(((*foo2< 1 2 3)) . => . '(1 2 3))
(((*foo2< 1 2) 3) . => . '(1 2 3))
(((curry + 1 2) 3) . => . 6)
(((++ 1 2) 3) . => . 6)
(((++) 1 2) . => . 3)
(((++)) . => . 0)
(((curry foo35 1 2) 3) . => . 3)
(((curry foo35 1 2 3)) . => . 3)
(((*foo35 1 2) 3) . => . 3)
(((*foo35 1 2 3)) . => . 3)
(((((*foo35 1 2 3 4))) 5) . => . 5)
(((((((((((*foo35)) 1)) 2)) 3 4))) 5) . => . 5)
((*foo:x2 1 2 3) . => . 12)
((map *foo:x2 '(1 2 3)) . => . '(2 4 6))
((((curryr foo3 1) 2) 3) . => . '(3 2 1))
(((curryr list 1) 2 3) . => . '(2 3 1))
)
(report-errs)