ikarus/lib/SRFI-2.tests.ss

84 lines
2.6 KiB
Scheme
Executable File

#!/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")