Permalink
Browse files

Improved tests for SRFI-2 (tests errors now)

  • Loading branch information...
1 parent 631f55a commit feac5dd87ba430462c1e7eb74fb31469401dadc7 Álvaro Castro-Castilla committed May 14, 2010
Showing with 12 additions and 46 deletions.
  1. +2 −2 srfi/2.scm
  2. +0 −30 srfi/34.scm
  3. +0 −6 srfi/64.scm
  4. +10 −8 srfi/test-2.scm
View
@@ -163,9 +163,9 @@
(set-cdr! growth-point `((let (,claw) (and . ,var-cell))))
(set! growth-point var-cell)))
(else
- (error "Syntax error: an ill-formed binding in a syntactic form let-and*"
+ (error "Syntax error: an ill-formed binding in a syntactic form let-and*"
claw))
- ))
+ ))
claws)
(if (not (null? body))
(andjoin! `(begin ,@body)))
View
@@ -3,36 +3,6 @@
;;
;; Adapted to Blackhole for Gambit by Álvaro Castro-Castilla
-(define *current-exception-handlers*
- (list (lambda (condition)
- (error "unhandled exception" condition))))
-
-#|
-(define (with-exception-handler handler thunk)
- (with-exception-handlers (cons handler *current-exception-handlers*)
- thunk))
-|#
-
-(define (with-exception-handlers new-handlers thunk)
- (let ((previous-handlers *current-exception-handlers*))
- (dynamic-wind
- (lambda ()
- (set! *current-exception-handlers* new-handlers))
- thunk
- (lambda ()
- (set! *current-exception-handlers* previous-handlers)))))
-
-#|
-(define (raise obj)
- (let ((handlers *current-exception-handlers*))
- (with-exception-handlers (cdr handlers)
- (lambda ()
- ((car handlers) obj)
- (error "handler returned"
- (car handlers)
- obj)))))
-|#
-
(define-syntax guard
(syntax-rules ()
((guard (var clause ...) e1 e2 ...)
View
@@ -494,12 +494,6 @@
(syntax-rules ()
((%test-evaluate-with-catch test-expression)
(guard (err (else #f)) test-expression))))
-#|
-(define-syntax %test-evaluate-with-catch
- (syntax-rules ()
- ((%test-evaluate-with-catch test-expression)
- test-expression)))
-|#
(define (%test-source-line2 form)
'())
View
@@ -1,8 +1,9 @@
-(import (std srfi/64))
+;(import (std srfi/64))
+(import ./64)
(import ./2)
-(test-begin "srfi-2" 28)
+(test-begin "srfi-2" 31)
(test-equal (and-let* () 1) 1)
(test-equal (and-let* () 1 2) 2)
@@ -12,9 +13,7 @@
(test-equal (let ((x 1)) (and-let* (x))) 1)
(test-equal (and-let* ((x #f)) ) #f)
(test-equal (and-let* ((x 1)) ) 1)
-;(test-error (and-let* ( #f (x 1))) )
(test-equal (and-let* ( (#f) (x 1)) ) #f)
-;(test-error (and-let* (2 (x 1))) )
(test-equal (and-let* ( (2) (x 1)) ) 1)
(test-equal (and-let* ( (x 1) (2)) ) 2)
(test-equal (let ((x #f)) (and-let* (x) x)) #f)
@@ -26,10 +25,6 @@
(test-equal (let ((x 1)) (and-let* (((positive? x))) )) #t)
(test-equal (let ((x 0)) (and-let* (((positive? x))) (+ x 1))) #f)
(test-equal (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1))) 3)
-#;(test-error
- #t
- (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))
- )
(test-equal (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))) 2)
(test-equal (let ((x 1)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))) 2)
@@ -42,4 +37,11 @@
(test-equal (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
(test-equal (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) 3/2)
+;; Needs to use eval to expand macro in current environment (CHECK!)
+(test-error (eval '(and-let* ( #f (x 1))) (interaction-environment)))
+(test-error (eval '(and-let* (2 (x 1))) (interaction-environment)))
+(test-error
+ (eval '(let ((x 1)) (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))
+ (interaction-environment)))
+
(test-end "srfi-2")

0 comments on commit feac5dd

Please sign in to comment.