Test output for simple-contracts [ok]

Testing time: 0s

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

Testing SIMPLE-CONTRACTS ...
----------------------------
"QUERIES"
... passed in (contracts?)
'(define-values
   (add add-pre add-post)
   (xlambda
     ((result integer? odd? (cut = <> (apply + x y ys)))
      <-
      (x integer? odd?)
      (y integer? even?)
      ys
      integer?
      even?)
     (apply + x y ys)))
... passed in (contracts?)
(= (add 1 2 4 6) 13)
... passed in (contracts?)
(equal? add-pre '((x integer? odd?) (y integer? even?) ys integer? even?))
... passed in (contracts?)
(equal? add-post '(result integer? odd? (cut = <> (apply + x y ys))))
... passed in (contracts?)
(not (condition-case (add 1 2 3) ((exn) #f)))
... passed in (contracts?)
'(define wrong-add
   (xlambda
     ((result integer? even?) <- (x integer? odd?) xs integer? even?)
     (apply + x xs)))
... passed in (contracts?)
(not (condition-case (wrong-add 1 2 4) ((exn) #f)))
... passed in (contracts?)
'(define-values
   (divide divide-pre divide-post)
   (xlambda
     ((q integer?)
      (r (lambda (x) (= (+ x (* n q)) m))
         <-
         (m integer? (cut >= <> 0))
         (n integer? positive?))
      (let loop ((q 0) (r m))
        (if (< r n) (values q r) (loop (+ q 1) (- r n)))))))
... passed in (contracts?)
(equal? (call-with-values (lambda () (divide 385 25)) list) '(15 10))
... passed in (contracts?)
(equal? divide-pre '((m integer? (cut >= <> 0)) (n integer? positive?)))
... passed in (contracts?)
(equal? divide-post '((q integer?) (r (lambda (x) (= (+ x (* n q)) m)))))
... passed in (contracts?)
"COMMANDS"
... passed in (contracts?)
'(define-values
   (counter! counter)
   (let ((state 0))
     (values
       (xlambda
         ((new (cut = <> (add1 old))) (old integer?) <-)
         (let ((old state)) (set! state (add1 state)) (values state old)))
       (xlambda ((result (cut = <> state)) <-) state))))
... passed in (contracts?)
(zero? (counter))
... passed in (contracts?)
(counter!)
... passed in (contracts?)
(= (counter) 1)
... passed in (contracts?)
(counter!)
... passed in (contracts?)
(= (counter) 2)
... passed in (contracts?)
'(define-values
   (push pop top)
   (let ((stk '()))
     (let ((push (xlambda
                   ((new list? (cut equal? <> (cons arg old)))
                    (old list?)
                    <-
                    (arg))
                   (let ((old stk))
                     (set! stk (cons arg stk))
                     (values stk old))))
           (pop (xlambda
                  ((new list? (cut equal? <> (cdr old))) (old list?) <-)
                  (let ((old (<<< 'pop stk (o not null?))))
                    (set! stk (cdr stk))
                    (values stk old))))
           (top (xlambda ((result) <-) (car (<<< 'top stk (o not null?))))))
       (values push pop top))))
... passed in (contracts?)
(push 0)
... passed in (contracts?)
(push 1)
... passed in (contracts?)
(= 1 (top))
... passed in (contracts?)
(equal? (call-with-values (lambda () (push 2)) list) '((2 1 0) (1 0)))
... passed in (contracts?)
(= 2 (top))
... passed in (contracts?)
(equal? (call-with-values (lambda () (pop)) list) '((1 0) (2 1 0)))
... passed in (contracts?)
"XDEFINE"
... passed in (contracts?)
'(xdefine
   ((result integer?) #(sum-post sum sum-pre) (a integer?) as integer?)
   (apply + a as))
... passed in (contracts?)
(= (sum 1 2 3) 6)
... passed in (contracts?)
(not (condition-case (sum 1 2 #f) ((exn) #f)))
... passed in (contracts?)
'(xdefine ((result list?) wrong-sum (a integer?) as integer?) (apply + a as))
... passed in (contracts?)
(not (condition-case (wrong-sum 1 2 3) ((exn) #f)))
... passed in (contracts?)

Results of SIMPLE-CONTRACTS
----------------------------
All tests passed