Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-16 09:27:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Updating SRFI-2 to support single variable references as clauses, and adding tests.

Browse source 
Also allowing empty bodies.  (I think both are terrible extensions.)
This commit is contained in:
Alex Shinn 2012-12-15 13:06:32 +09:00
parent b63537a8cc
commit e4b86a5807
2 changed files with 52 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lib/srfi/2.sld
View file

@ -6,10 +6,18 @@
(define-syntax and-let* (define-syntax and-let*
(syntax-rules () (syntax-rules ()
((and-let* () . body) ((and-let* () . body)
(begin . body)) (begin #t . body))
((and-let* ((var expr)))
expr)
((and-let* ((expr)))
expr)
((and-let* (expr)) ; Extension: in SRFI-2 this can only be a var ref
expr)
((and-let* ((var expr) . rest) . body) ((and-let* ((var expr) . rest) . body)
(let ((var expr)) (let ((var expr))
(and var (and-let* rest . body)))) (and var (and-let* rest . body))))
((and-let* ((expr) . rest) . body) ((and-let* ((expr) . rest) . body)
(and expr (and-let* rest . body)))
((and-let* (expr . rest) . body) ; Same extension as above
(let ((tmp expr)) (let ((tmp expr))
(and tmp (and-let* rest . body)))))))) (and tmp (and-let* rest . body))))))))

43
tests/srfi-2-tests.scm Normal file
View file

@ -0,0 +1,43 @@
(import (scheme base) (srfi 2) (chibi test))
(test-begin "srfi-2")
(test 1 (and-let* () 1))
(test 2 (and-let* () 1 2))
(test #t (and-let* () ))
(test #f (let ((x #f)) (and-let* (x))))
(test 1 (let ((x 1)) (and-let* (x))))
(test #f (and-let* ((x #f)) ))
(test 1 (and-let* ((x 1)) ))
;; (test-syntax-error (and-let* ( #f (x 1))))
(test #f (and-let* ( (#f) (x 1)) ))
;; (test-syntax-error (and-let* (2 (x 1))))
(test 1 (and-let* ( (2) (x 1)) ))
(test 2 (and-let* ( (x 1) (2)) ))
(test #f (let ((x #f)) (and-let* (x) x)))
(test "" (let ((x "")) (and-let* (x) x)))
(test "" (let ((x "")) (and-let* (x) )))
(test 2 (let ((x 1)) (and-let* (x) (+ x 1))))
(test #f (let ((x #f)) (and-let* (x) (+ x 1))))
(test 2 (let ((x 1)) (and-let* (((positive? x))) (+ x 1))))
(test #t (let ((x 1)) (and-let* (((positive? x))) )))
(test #f (let ((x 0)) (and-let* (((positive? x))) (+ x 1))))
(test 3 (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1))))
(test 4
(let ((x 1))
(and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))
(test 2 (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))))
(test 2 (let ((x 1)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))))
(test #f (let ((x 0)) (and-let* (x ((positive? x))) (+ x 1))))
(test #f (let ((x #f)) (and-let* (x ((positive? x))) (+ x 1))))
(test #f (let ((x #f)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))))
(test #f (let ((x 1)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
(test #f (let ((x 0)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
(test #f (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
(test 3/2 (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
(test-end)