[uim-commit] r2142 - branches/r5rs/sigscheme/test
yamaken at freedesktop.org
yamaken at freedesktop.org
Mon Nov 14 07:19:00 PST 2005
Author: yamaken
Date: 2005-11-14 07:18:56 -0800 (Mon, 14 Nov 2005)
New Revision: 2142
Modified:
branches/r5rs/sigscheme/test/test-srfi34-2.scm
branches/r5rs/sigscheme/test/test-srfi34.scm
Log:
* sigscheme/test/test-srfi34.scm
* sigscheme/test/test-srfi34-2.scm
- Uncomment all tests. statuses are not updated, and some tests are
still failed
Modified: branches/r5rs/sigscheme/test/test-srfi34-2.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi34-2.scm 2005-11-14 15:13:38 UTC (rev 2141)
+++ branches/r5rs/sigscheme/test/test-srfi34-2.scm 2005-11-14 15:18:56 UTC (rev 2142)
@@ -67,17 +67,17 @@
;; Then behaves in an unspecified way. Although the behavior when a handler
;; returned is not specified in SRFI-34, SigScheme should produce an error to
;; prevent being misused by users.
-;;(print-expected "something went wrong")
-;;(assert-error "Examples of SRFI-34 document #2"
-;; (lambda ()
-;; (call-with-current-continuation
-;; (lambda (k)
-;; (with-exception-handler (lambda (x)
-;; (display "something went wrong")
-;; (newline)
-;; 'dont-care)
-;; (lambda ()
-;; (+ 1 (raise 'an-error))))))))
+(print-expected "something went wrong")
+(assert-error "Examples of SRFI-34 document #2"
+ (lambda ()
+ (call-with-current-continuation
+ (lambda (k)
+ (with-exception-handler (lambda (x)
+ (display "something went wrong")
+ (newline)
+ 'dont-care)
+ (lambda ()
+ (+ 1 (raise 'an-error))))))))
;;PRINTS: condition: an-error
(print-expected "condition: an-error")
@@ -103,32 +103,32 @@
(+ 1 (raise 'an-error))))
;; SEGV
-;;(assert-equal? "Examples of SRFI-34 document #5"
-;; 'positive
-;; (call-with-current-continuation
-;; (lambda (k)
-;; (with-exception-handler (lambda (x)
-;; (display "reraised ") (write x) (newline)
-;; (k 'zero))
-;; (lambda ()
-;; (guard (condition
-;; ((positive? condition) 'positive)
-;; ((negative? condition) 'negative))
-;; (raise 1)))))))
+(assert-equal? "Examples of SRFI-34 document #5"
+ 'positive
+ (call-with-current-continuation
+ (lambda (k)
+ (with-exception-handler (lambda (x)
+ (display "reraised ") (write x) (newline)
+ (k 'zero))
+ (lambda ()
+ (guard (condition
+ ((positive? condition) 'positive)
+ ((negative? condition) 'negative))
+ (raise 1)))))))
;; SEGV
-;;(assert-equal? "Examples of SRFI-34 document #6"
-;; 'negative
-;; (call-with-current-continuation
-;; (lambda (k)
-;; (with-exception-handler (lambda (x)
-;; (display "reraised ") (write x) (newline)
-;; (k 'zero))
-;; (lambda ()
-;; (guard (condition
-;; ((positive? condition) 'positive)
-;; ((negative? condition) 'negative))
-;; (raise -1)))))))
+(assert-equal? "Examples of SRFI-34 document #6"
+ 'negative
+ (call-with-current-continuation
+ (lambda (k)
+ (with-exception-handler (lambda (x)
+ (display "reraised ") (write x) (newline)
+ (k 'zero))
+ (lambda ()
+ (guard (condition
+ ((positive? condition) 'positive)
+ ((negative? condition) 'negative))
+ (raise -1)))))))
;;PRINTS: reraised 0
(print-expected "reraised 0")
Modified: branches/r5rs/sigscheme/test/test-srfi34.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi34.scm 2005-11-14 15:13:38 UTC (rev 2141)
+++ branches/r5rs/sigscheme/test/test-srfi34.scm 2005-11-14 15:18:56 UTC (rev 2142)
@@ -70,12 +70,12 @@
;; FAILED: infinite loop with a message "Error: missing argument(s)"
;; handler a procedure but takes 2 arguments
-;;(my-assert-error "with-exception-handler invalid form #2"
-;; (lambda ()
-;; (with-exception-handler
-;; eq?
-;; (lambda ()
-;; (+ 1 (raise 'obj))))))
+(my-assert-error "with-exception-handler invalid form #2"
+ (lambda ()
+ (with-exception-handler
+ eq?
+ (lambda ()
+ (+ 1 (raise 'obj))))))
;; thunk is not a procedure
(my-assert-error "with-exception-handler invalid form #3"
@@ -107,14 +107,14 @@
(+ 1 (raise 'obj)))))))
;; SEGV
-;;(assert-error "with-exception-handler #3"
-;; (lambda ()
-;; (with-exception-handler
-;; (lambda (x)
-;; (assert-equal? "with-exception-handler #2" 'an-error x)
-;; 'a-handler-must-not-return)
-;; (lambda ()
-;; (+ 1 (raise 'an-error))))))
+(assert-error "with-exception-handler #3"
+ (lambda ()
+ (with-exception-handler
+ (lambda (x)
+ (assert-equal? "with-exception-handler #2" 'an-error x)
+ 'a-handler-must-not-return)
+ (lambda ()
+ (+ 1 (raise 'an-error))))))
(assert-equal? "with-exception-handler #4"
6
@@ -196,10 +196,10 @@
;;
;; SEGV
-;;(my-assert-error "guard handler invalid form #1"
-;; (lambda ()
-;; (guard (var)
-;; (raise 'obj))))
+(my-assert-error "guard handler invalid form #1"
+ (lambda ()
+ (guard (var)
+ (raise 'obj))))
;; FAILED
(my-assert-error "guard handler invalid form #2"
@@ -218,43 +218,43 @@
;; SEGV
;; 'else' followed by another caluse
-;;(my-assert-error "guard handler invalid form #4"
-;; (lambda ()
-;; (guard (var
-;; (else #t)
-;; (#t))
-;; (raise 'obj))))
+(my-assert-error "guard handler invalid form #4"
+ (lambda ()
+ (guard (var
+ (else #t)
+ (#t))
+ (raise 'obj))))
;; SEGV
;; not specified in R5RS 'case', but SigScheme should cause error
-;;(if (provided? "sigscheme")
-;; (my-assert-error "guard handler invalid form #5"
-;; (lambda ()
-;; (guard (var
-;; (else))
-;; (raise 'obj)))))
+(if (provided? "sigscheme")
+ (my-assert-error "guard handler invalid form #5"
+ (lambda ()
+ (guard (var
+ (else))
+ (raise 'obj)))))
;; SEGV
-;;(my-assert-error "guard handler invalid form #6"
-;; (lambda ()
-;; (guard (var
-;; (#t =>))
-;; (raise 'obj))))
+(my-assert-error "guard handler invalid form #6"
+ (lambda ()
+ (guard (var
+ (#t =>))
+ (raise 'obj))))
;; SEGV
-;;(my-assert-error "guard handler invalid form #7"
-;; (lambda ()
-;; (guard (var
-;; (#t =>)
-;; (else #t))
-;; (raise 'obj))))
+(my-assert-error "guard handler invalid form #7"
+ (lambda ()
+ (guard (var
+ (#t =>)
+ (else #t))
+ (raise 'obj))))
;; SEGV
-;;(my-assert-error "guard handler invalid form #8"
-;; (lambda ()
-;; (guard (var
-;; (else =>))
-;; (raise 'obj))))
+(my-assert-error "guard handler invalid form #8"
+ (lambda ()
+ (guard (var
+ (else =>))
+ (raise 'obj))))
;; FAILED
;; not a procedure
@@ -332,15 +332,15 @@
;;
;; SEGV
-;;(assert-equal? "mixed exception handling #1"
-;; 'guard-ret
-;; (with-exception-handler (lambda (x)
-;; (k 'with-exception-ret))
-;; (lambda ()
-;; (guard (condition
-;; (else
-;; 'guard-ret))
-;; (raise 1)))))
+(assert-equal? "mixed exception handling #1"
+ 'guard-ret
+ (with-exception-handler (lambda (x)
+ (k 'with-exception-ret))
+ (lambda ()
+ (guard (condition
+ (else
+ 'guard-ret))
+ (raise 1)))))
(assert-equal? "mixed exception handling #2"
'with-exception-ret
@@ -353,30 +353,30 @@
(raise 1)))))
;; SEGV
-;;(assert-equal? "mixed exception handling #3"
-;; 'positive
-;; (call-with-current-continuation
-;; (lambda (k)
-;; (with-exception-handler (lambda (x)
-;; (k 'zero))
-;; (lambda ()
-;; (guard (condition
-;; ((positive? condition) 'positive)
-;; ((negative? condition) 'negative))
-;; (raise 1)))))))
+(assert-equal? "mixed exception handling #3"
+ 'positive
+ (call-with-current-continuation
+ (lambda (k)
+ (with-exception-handler (lambda (x)
+ (k 'zero))
+ (lambda ()
+ (guard (condition
+ ((positive? condition) 'positive)
+ ((negative? condition) 'negative))
+ (raise 1)))))))
;; SEGV
-;;(assert-equal? "mixed exception handling #4"
-;; 'negative
-;; (call-with-current-continuation
-;; (lambda (k)
-;; (with-exception-handler (lambda (x)
-;; (k 'zero))
-;; (lambda ()
-;; (guard (condition
-;; ((positive? condition) 'positive)
-;; ((negative? condition) 'negative))
-;; (raise -1)))))))
+(assert-equal? "mixed exception handling #4"
+ 'negative
+ (call-with-current-continuation
+ (lambda (k)
+ (with-exception-handler (lambda (x)
+ (k 'zero))
+ (lambda ()
+ (guard (condition
+ ((positive? condition) 'positive)
+ ((negative? condition) 'negative))
+ (raise -1)))))))
(assert-equal? "mixed exception handling #5"
'zero
More information about the uim-commit
mailing list