84 lines
2.6 KiB
Scheme
84 lines
2.6 KiB
Scheme
|
#!/usr/bin/env ikarus --r6rs-script
|
||
|
|
(import (SRFI-2)
|
||
|
|
(only (ikarus) error parameterize error-handler eval
|
||
|
|
environment)
|
||
|
|
(r6rs))
|
||
|
|
|
||
|
|
(define-syntax expect
|
||
|
|
(syntax-rules ()
|
||
|
|
[(_ e0 e1)
|
||
|
|
(let ([v0 e0] [v1 e1])
|
||
|
|
(if (equal? v0 v1)
|
||
|
|
'ok
|
||
|
|
(error #f "failed in ~s" '(expect e0 e1))))]))
|
||
|
|
|
||
|
|
(define-syntax must-be-a-syntax-error
|
||
|
|
(syntax-rules ()
|
||
|
|
[(_ form)
|
||
|
|
((call/cc
|
||
|
|
(lambda (k)
|
||
|
|
(parameterize ([error-handler
|
||
|
|
(lambda args
|
||
|
|
(k (lambda ()
|
||
|
|
(display "failed as expected\n"))))])
|
||
|
|
(eval 'form (environment '(r6rs) '(SRFI-2)))
|
||
|
|
(lambda ()
|
||
|
|
(error #f "did not fail"))))))]))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(display "loaded!\n")
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(expect (land* () 1) 1)
|
||
|
|
(expect (land* () 1 2) 2)
|
||
|
|
(expect (land* () ) #t)
|
||
|
|
|
||
|
|
(expect (let ((x #f)) (land* (x))) #f)
|
||
|
|
(expect (let ((x 1)) (land* (x))) 1)
|
||
|
|
(expect (land* ((x #f)) ) #f)
|
||
|
|
(expect (land* ((x 1)) ) 1)
|
||
|
|
(must-be-a-syntax-error (land* ( #f (x 1))) )
|
||
|
|
(expect (land* ( (#f) (x 1)) ) #f)
|
||
|
|
(must-be-a-syntax-error (land* (2 (x 1))) )
|
||
|
|
(expect (land* ( (2) (x 1)) ) 1)
|
||
|
|
(expect (land* ( (x 1) (2)) ) 2)
|
||
|
|
(expect (let ((x #f)) (land* (x) x)) #f)
|
||
|
|
(expect (let ((x "")) (land* (x) x)) "")
|
||
|
|
(expect (let ((x "")) (land* (x) )) "")
|
||
|
|
(expect (let ((x 1)) (land* (x) (+ x 1))) 2)
|
||
|
|
(expect (let ((x #f)) (land* (x) (+ x 1))) #f)
|
||
|
|
(expect (let ((x 1)) (land* (((positive? x))) (+ x 1))) 2)
|
||
|
|
(expect (let ((x 1)) (land* (((positive? x))) )) #t)
|
||
|
|
(expect (let ((x 0)) (land* (((positive? x))) (+ x 1))) #f)
|
||
|
|
(expect (let ((x 1)) (land* (((positive? x)) (x (+ x 1))) (+ x 1))) 3)
|
||
|
|
; this is wrong
|
||
|
|
; the srfi says:
|
||
|
|
; ``As usual, all VARIABLEs must be unique (like in let*) ''
|
||
|
|
; but the variables in let* need not be unique; so, it must be
|
||
|
|
; a mistake
|
||
|
|
|
||
|
|
;(must-be-a-syntax-error
|
||
|
|
; (let ((x 1))
|
||
|
|
; (land* (((positive? x))
|
||
|
|
; (x (+ x 1))
|
||
|
|
; (x (+ x 1)))
|
||
|
|
; (+ x 1))))
|
||
|
|
|
||
|
|
(expect (let ((x 1)) (land* (x ((positive? x))) (+ x 1))) 2)
|
||
|
|
(expect (let ((x 1)) (land* ( ((begin x)) ((positive? x))) (+ x 1))) 2)
|
||
|
|
(expect (let ((x 0)) (land* (x ((positive? x))) (+ x 1))) #f)
|
||
|
|
(expect (let ((x #f)) (land* (x ((positive? x))) (+ x 1))) #f)
|
||
|
|
(expect (let ((x #f)) (land* ( ((begin x)) ((positive? x))) (+ x 1))) #f)
|
||
|
|
|
||
|
|
;(expect (let ((x 1)) (land* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
|
||
|
|
;(expect (let ((x 0)) (land* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
|
||
|
|
;(expect (let ((x #f)) (land* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
|
||
|
|
;(expect (let ((x 3)) (land* (x (y (- x 1)) ((positive? y))) (/ x y))) 3/2)
|
||
|
|
|
||
|
|
(display "All tests passed\n")
|
||
|
|
|
||
|
|
|