Test output for bindings [ok]

Testing time: 24s

'/home/chicken/salmonella/build/salmonella-run-publish/chicken/bin/csi' -script run.scm < /dev/null 2>&1

Testing BINDINGS ...
----------------------------
(= (bind a 1 a) 1)
... passed in (binds?)
(= (bind (a ()) (list 1 "") a) 1)
... passed in (binds?)
(equal? (bind (a b) '(1 2) (where (a odd?)) (list a b)) '(1 2))
... passed in (binds?)
(equal? (bind (x . y) '#(1 2 3 4) (list x y)) '(1 #(2 3 4)))
... passed in (binds?)
(equal? (bind (_ . y) '#(1 2 3 4) y) '#(2 3 4))
... passed in (binds?)
(equal?
  (bind (x (y (z u . v)) w) '(1 #(2 "foo") 4) (list x y z u v w))
  '(1 2 #\f #\o "o" 4))
... passed in (binds?)
(equal?
  (bind (x (y (z u . _)) w) '(1 #(2 "foo") 4) (list x y z u w))
  '(1 2 #\f #\o 4))
... passed in (binds?)
(equal? (bind (x (y . _) . _) '(1 #(2 3 4) 5 6) (list x y)) '(1 2))
... passed in (binds?)
(equal? (bind (x (y _ . _) . _) '(1 #(2 3 4) 5 6) (list x y)) '(1 2))
... passed in (binds?)
(equal?
  (bind (x (y (z . u)) v . w)
        (vector 1 (list 2 (cons #f #f)) 5 6)
        (list x y z u v w))
  '(1 2 #f #f 5 #(6)))
... passed in (binds?)
(equal?
  (bind (x (y (#f . u)) v . w)
        (vector 1 (list 2 (cons (odd? 4) #f)) 5 6)
        (list x y u v w))
  '(1 2 #f 5 #(6)))
... passed in (binds?)
(equal?
  (bind (x (y (z . u)) v . w) '#(1 (2 (3 . 4)) 5 6) (list x y z u v w))
  '(1 2 3 4 5 #(6)))
... passed in (binds?)
(equal?
  (bind-named
    loop
    (x (a . b) y)
    '(5 #(1) 0)
    (where (x integer?))
    (if (zero? x)
      (list x a b y)
      (loop (list (- x 1) (cons a (cons a b)) (+ y 1)))))
  '(0 1 (1 1 1 1 1 . #()) 5))
... passed in (binds?)
(equal?
  (bind-named
    loop
    (x y)
    #(5 0)
    (where (x integer?))
    (if (zero? x) (vector x y) (loop (vector (- x 1) (+ y 1)))))
  '#(0 5))
... passed in (binds?)
"LITERALS"
... passed in (binds?)
(equal? (bind (#f . ys) '(#f 2 3) ys) '(2 3))
... passed in (binds?)
(not (condition-case (bind (#f . ys) '(#t 2 3) ys) ((exn sequence) #f)))
... passed in (binds?)
(bind #f #f #t)
... passed in (binds?)
(not (condition-case (bind #f #t #t) ((exn sequence) #f)))
... passed in (binds?)
(not (condition-case (bind (x . #f) '(1 . #t) x) ((exn sequence) #f)))
... passed in (binds?)
(equal? (bind (x (y . #f)) '(1 (2 . #f)) (list x y)) '(1 2))
... passed in (binds?)
(not (condition-case
       (bind (x (y . #f)) '(1 (2 . #t)) (list x y))
       ((exn sequence) #f)))
... passed in (binds?)
(equal? (bind ((x . #f) y . #f) '((1 . #f) 2 . #f) (list x y)) '(1 2))
... passed in (binds?)
(not (condition-case
       (bind ((x . #f) y . #f) '((1 . #f) 2 . #t) (list x y))
       ((exn sequence) #f)))
... passed in (binds?)
(not (condition-case
       (bind ((x . #f) y . #f) '((1 . #t) 2 . #f) (list x y))
       ((exn sequence) #f)))
... passed in (binds?)
(bind ((x . z) y . #f) '((1 . 3) 2 . #f) (list x y z))
... passed in (binds?)
(not ((bindable? (x)) '(name 1)))
... passed in (predicates?)
(not ((bindable? (x y) (where (x number?))) '(name 1)))
... passed in (predicates?)
((bindable? (_ x)) '(name 1))
... passed in (predicates?)
(not ((bindable? (_ x)) '(name 1 2)))
... passed in (predicates?)
((bindable? (a b) (where (a odd?))) '#(1 2))
... passed in (predicates?)
(not ((bindable? (x (y z)) (where (y char-alphabetic?))) '(1 "23")))
... passed in (predicates?)
((bindable? (x (y . z))) '(1 "23"))
... passed in (predicates?)
((bindable? (x y)) '(1 "23"))
... passed in (predicates?)
(not ((bindable? (a (b . C) . d)) '(1 2 3 4 5)))
... passed in (predicates?)
(not ((bindable? (a)) 1))
... passed in (predicates?)
(not (bind-case #() (() #f)))
... passed in (cases?)
(equal?
  (bind-case
    #(2 2)
    ((a b) (where (a even?) (b odd?)) (print 'even-odd a b))
    ((a b) (where (a odd?) (b even?)) (print 'odd-even a b))
    ((a b) (list a b)))
  '(2 2))
... passed in (cases?)
(equal?
  (bind-case
    '(1 "2 3")
    ((x (y z)) (list x y z))
    ((x (y . z)) (list x y z))
    ((x y) (list x y)))
  '(1 #\2 " 3"))
... passed in (cases?)
(equal?
  (bind-case
    '(1 "23")
    ((x (y z)) (where (y char-alphabetic?)) (list x y z))
    ((x (y . z)) (list x y z))
    ((x y) (list x y)))
  '(1 #\2 "3"))
... passed in (cases?)
(equal?
  (bind-case
    '(1 "23")
    ((x (y z)) (where (y char-alphabetic?)) (list x y z))
    ((x (y . _)) (list x y))
    ((x y) (list x y)))
  '(1 #\2))
... passed in (cases?)
(equal?
  (bind-case
    '(1 "23")
    ((x (y z)) (where (y char-numeric?)) (list x y z))
    ((x (y . z)) (list x y z))
    ((x y) (list x y)))
  '(1 #\2 #\3))
... passed in (cases?)
(equal?
  (bind-case
    '(1 "23")
    ((x (y z)) (list x y z))
    ((x (y . z)) (list x y z))
    ((x y) (list x y)))
  '(1 #\2 #\3))
... passed in (cases?)
(equal?
  (bind-case
    '(1 "2 3")
    ((x (y . z)) (list x y z))
    ((x (y z)) (list x y z))
    ((x y) (list x y)))
  '(1 #\2 " 3"))
... passed in (cases?)
(equal?
  (bind-case
    '(1 #(2 3))
    ((x y) (where (y list?)) (list x y))
    ((x (y . z)) (list x y z))
    ((x (y z)) (list x y z)))
  '(1 2 #(3)))
... passed in (cases?)
(equal?
  (bind-case
    '(1 (2 3))
    ((x y) (list x y))
    ((x (y . z)) (list x y z))
    ((x (y z)) (list x y z)))
  '(1 (2 3)))
... passed in (cases?)
(equal?
  (bind-case
    '(1 (2 . 3))
    ((x y) (list x y))
    ((x (y . z)) (list x y z))
    ((x (y z)) (list x y z)))
  '(1 (2 . 3)))
... passed in (cases?)
(equal?
  (bind-case
    '#(1 2)
    (() '())
    ((a) (list a))
    ((a b) (list a b))
    ((a b C) (list a b C)))
  '(1 2))
... passed in (cases?)
"LOCAL VARIABLES IN ALL RULES"
... passed in (cases?)
'(define (my-map fn lst)
   (let loop ((lst lst) (result '()))
     (bind-case
       lst
       (() (reverse result))
       ((x . xs) (loop xs (cons (fn x) result))))))
... passed in (cases?)
(equal? (my-map add1 '(0 1 2 3)) '(1 2 3 4))
... passed in (cases?)
'(define (vector-map fn vec)
   (let* ((len (vector-length vec)) (result (make-vector len #f)))
     (let loop ((vec vec))
       (bind-case
         vec
         (() result)
         ((x . xs)
          (vector-set! result (- len (vector-length xs) 1) (fn x))
          (loop (subvector vec 1)))))))
... passed in (cases?)
(equal? (vector-map add1 #(0 1 2 3)) #(1 2 3 4))
... passed in (cases?)
'(define (vector-reverse vec)
   (let ((result (make-vector (vector-length vec) #f)))
     (let loop ((vec vec))
       (bind-case
         vec
         (() result)
         ((x . xs)
          (vector-set! result (vector-length xs) x)
          (loop (subvector vec 1)))))))
... passed in (cases?)
(equal? (vector-reverse #(0 1 2 3)) #(3 2 1 0))
... passed in (cases?)
"NON-SYMBOL LITERALS"
... passed in (cases?)
(bind-case #("a") ((#f) #f) (("a") #t))
... passed in (cases?)
(equal?
  (bind-case
    (vector 1 (list (odd? 2) 3))
    ((x y) (where (y number?)) (list x y))
    ((x ("y" . z)) (list x z))
    ((x (#f z)) (list x z)))
  '(1 3))
... passed in (cases?)
(equal?
  (bind-case
    '(1 (#f 3))
    ((x y) (list x y))
    ((x ("y" . z)) (list x z))
    ((x (#f z)) (list x z)))
  '(1 (#f 3)))
... passed in (cases?)
(equal?
  (bind-case #(1 ("y" 3)) ((x ("y" . z)) (list x z)) ((x (#f z)) (list x z)))
  '(1 (3)))
... passed in (cases?)
(equal?
  ((bind-lambda (a (b . C) . d) (list a b C d)) '(1 #(20 30 40) 2 3))
  '(1 20 #(30 40) (2 3)))
... passed in (lambdas?)
(equal?
  ((bind-lambda* ((a (b . C) . d) (e . f)) (list a b C d e f))
   '(1 #(20 30 40) 2 3)
   '#(4 5 6))
  '(1 20 #(30 40) (2 3) 4 #(5 6)))
... passed in (lambdas?)
(equal?
  ((bind-case-lambda ((e . f) (where (e zero?)) f) ((e . f) (list e f)))
   '#(0 2 3 4 5))
  '#(2 3 4 5))
... passed in (lambdas?)
(equal?
  ((bind-case-lambda
     ((e . f) (where (e zero?)) e)
     ((a (b . #f) . d) (list a b d))
     ((e . f) (list e f)))
   '(1 (2 . #f) 4 5))
  '(1 2 (4 5)))
... passed in (lambdas?)
(equal?
  ((bind-case-lambda
     ((e . f) (where (e zero?)) e)
     ((a (b . #f) . d) (list a b d))
     ((e . f) (list e f)))
   '(1 (2 . #t) 4 5))
  '(1 ((2 . #t) 4 5)))
... passed in (lambdas?)
(not (condition-case
       ((bind-case-lambda
          ((e . f) (where (e zero?)) e)
          ((a (b . #f) . d) (list a b d)))
        '(1 (2 . #t) 4 5))
       ((exn sequence) #f)))
... passed in (lambdas?)
(equal?
  ((bind-case-lambda
     ((e . f) (where (e zero?)) e)
     ((a (b "c") . d) (list a b d))
     ((e . f) (list e f)))
   '(1 (2 "c") 4 5))
  '(1 2 (4 5)))
... passed in (lambdas?)
(equal?
  ((bind-case-lambda
     ((a (b . C) . d) (where (a integer?)) (list a b C d))
     ((e . f) (list e f)))
   '(1 #(2 3 4) 5 6))
  '(1 2 #(3 4) (5 6)))
... passed in (lambdas?)
(equal?
  ((bind-case-lambda
     ((a (b . C) . d) (where (a string?)) (list a b C d))
     ((e . f) (list e f)))
   '(1 #(2 3 4) 5 6))
  '(1 (#(2 3 4) 5 6)))
... passed in (lambdas?)
(equal?
  ((bind-case-lambda* (((a b C . d) (e . f)) (list a b C d e f)))
   '(1 2 3)
   #(4 5 6))
  '(1 2 3 () 4 #(5 6)))
... passed in (lambdas?)
(equal?
  ((bind-case-lambda* (((a (b . C) . d) (e . f)) (list a b C d e f)))
   '(1 #(20 30 40) 2 3)
   '(4 5 6))
  '(1 20 #(30 40) (2 3) 4 (5 6)))
... passed in (lambdas?)
(equal?
  (bind-let
    ((((x y) z) '(#(1 2) 3)) (u (+ 2 2)) ((v w) #(5 6)))
    (where (u integer?))
    (list x y z u v w))
  '(1 2 3 4 5 6))
... passed in (lets?)
(equal?
  (bind-named
    loop
    (a b)
    '(5 0)
    (if (zero? a) (list a b) (loop (list (- a 1) (+ b 1)))))
  '(0 5))
... passed in (lets?)
(equal?
  (bind-let
    loop
    (((a b) '(5 0)))
    (where (a integer?))
    (if (zero? a) (list a b) (loop (list (- a 1) (+ b 1)))))
  '(0 5))
... passed in (lets?)
(equal?
  (bind-let
    loop
    (((x . y) '(1 2 3)) ((z) #(10)))
    (where (x integer?) (y (list-of? integer?)) (z integer?))
    (if (zero? z)
      (list x y z)
      (loop (cons (+ x 1) (map add1 y)) (list (- z 1)))))
  '(11 (12 13) 0))
... passed in (lets?)
(equal?
  (bind-let*
    ((((x y) z) '(#(1 2) 3)) (u (+ 1 2 x)) ((v w) (list (+ z 2) 6)))
    (where (u integer?))
    (list x y z u v w))
  '(1 2 3 4 5 6))
... passed in (lets?)
(equal?
  (bindrec
    ((o?) e?)
    (vector
      (list (lambda (m) (if (zero? m) #f (e? (- m 1)))))
      (lambda (n) (if (zero? n) #t (o? (- n 1)))))
    (where (o? procedure?) (e? procedure?))
    (list (o? 95) (e? 95)))
  '(#t #f))
... passed in (lets?)
(equal?
  (bind-letrec
    (((o? (e?))
      (list (lambda (m) (if (zero? m) #f (e? (- m 1))))
            (vector (lambda (n) (if (zero? n) #t (o? (- n 1))))))))
    (where (o? procedure?) (e? procedure?))
    (list (o? 95) (e? 95)))
  '(#t #f))
... passed in (lets?)
(equal?
  (let ((x #f) (y #f) (z #f))
    (bind-set! (x (y . z)) '(1 #(2 3 3)))
    (list x y z))
  '(1 2 #(3 3)))
... passed in (defines?)
(equal?
  (let ((x #f) (y #f) (z #f))
    (bind-set! (x #f _ (y _ . z)) '(1 #f 10 #(2 30 3 3)))
    (list x y z))
  '(1 2 #(3 3)))
... passed in (defines?)
(equal?
  (let ((x #f) (y #f) (z #f)) (bind-set! x 1 y 2 z 3) (list x y z))
  '(1 2 3))
... passed in (defines?)
(equal?
  (let ((x #f) (y #f) (z #f) (u #f) (v #f))
    (bind-set!
      (x (y . z))
      '(1 #(2 3 3))
      (u (v))
      '(10 (20))
      (where (x integer?) (u number?)))
    (list x y z u v))
  '(1 2 #(3 3) 10 20))
... passed in (defines?)
(equal?
  (let ((x #f) (y #f) (z #f))
    (bind-set! (x (y . z)) '(1 #(2 3 3)) (where (x integer?)))
    (list x y z))
  '(1 2 #(3 3)))
... passed in (defines?)
(equal?
  (begin
    '(define stack #f)
    '(define push! #f)
    '(define pop! #f)
    (bind-set!
      (stack (push! pop!))
      (list '()
            (vector
              (lambda (xpr) (set! stack (cons xpr stack)))
              (lambda () (set! stack (cdr stack)))))
      (where (push! procedure?) (pop! procedure?)))
    (push! 1)
    (push! 0)
    stack)
  '(0 1))
... passed in (defines?)
(equal?
  (begin
    (bind-define
      (plus5 times5)
      (let ((a 5)) (list (lambda (x) (+ x a)) (lambda (x) (* x a)))))
    (list (plus5 6) (times5 6)))
  '(11 30))
... passed in (defines?)
(equal?
  (begin
    (bind-define (x . y) '(1 . 2) ((z)) '((3)) (where (x integer?)))
    (list x y z))
  '(1 2 3))
... passed in (defines?)
(equal?
  (begin
    (bind-define (x _ . y) '(1 10 . 2) ((z)) '((3)) (where (x integer?)))
    (list x y z))
  '(1 2 3))
... passed in (defines?)
(equal?
  (begin (bind-define (x #f . y) '(1 #f . 2) ((z)) '((3))) (list x y z))
  '(1 2 3))
... passed in (defines?)
(equal?
  (begin (bind-define x 1 y 2 z 3 (where (x integer?))) (list x y z))
  '(1 2 3))
... passed in (defines?)
(equal?
  (begin
    (bind-define
      (push top pop)
      (let ((lst '()))
        (vector
          (lambda (xpr) (set! lst (cons xpr lst)))
          (lambda () (car lst))
          (lambda () (set! lst (cdr lst)))))
      (where (push procedure?) (top procedure?) (pop procedure?)))
    (push 0)
    (push 1)
    (pop)
    (top))
  0)
... passed in (defines?)
(equal?
  (begin (bind-define (x (_ y (z _))) '(1 #(2 3 (4 5)))) (list x y z))
  '(1 3 4))
... passed in (defines?)
(equal?
  (begin
    (bind-define
      (x (#f y (z #t)))
      (list 1 (vector (odd? 2) 3 (list 4 (odd? 5))))
      (where (x integer?)))
    (list x y z))
  '(1 3 4))
... passed in (defines?)

Results of BINDINGS
----------------------------
All tests passed