[uim-commit] r1756 - in branches/r5rs/sigscheme: . test

[kzk at freedesktop.org]

Author: kzk
Date: 2005-10-03 01:00:59 -0700 (Mon, 03 Oct 2005)
New Revision: 1756

Modified:
   branches/r5rs/sigscheme/config.h
   branches/r5rs/sigscheme/datas.c
   branches/r5rs/sigscheme/test/test-srfi34.scm
Log:
* sigscheme/datas.c
  - (Scm_CallWithCurrentContinuation): set EvalState's ret_type
* test/test-srfi34.scm
  - enable 3 test cases which uses call/cc
* sigscheme/config.h
  - (SCM_USE_SRFI34): enable again


Modified: branches/r5rs/sigscheme/config.h
===================================================================
--- branches/r5rs/sigscheme/config.h	2005-10-03 07:51:04 UTC (rev 1755)
+++ branches/r5rs/sigscheme/config.h	2005-10-03 08:00:59 UTC (rev 1756)
@@ -46,7 +46,7 @@
 #define SCM_USE_SRFI2           1  /* use SRFI-2  'and-let*' */
 #define SCM_USE_SRFI8           1  /* use SRFI-8  'receive' */
 #define SCM_USE_SRFI23          1  /* use SRFI-23 'error' */
-#define SCM_USE_SRFI34          0  /* use SRFI-34 exception handling for programs */
+#define SCM_USE_SRFI34          1  /* use SRFI-34 exception handling for programs */
 #define SCM_USE_SRFI38          1  /* use SRFI-38 'write-with-shared-structure' */
 #define SCM_USE_SRFI60          1  /* use SRFI-60 integers as bits */
 

Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c	2005-10-03 07:51:04 UTC (rev 1755)
+++ branches/r5rs/sigscheme/datas.c	2005-10-03 08:00:59 UTC (rev 1756)
@@ -944,6 +944,7 @@
          * not be Scm_tailcall(), to preserve current stack until longjmp()
          * called.
          */
+        eval_state->ret_type = SCM_RETTYPE_AS_IS;
         ret = Scm_call(proc, LIST_1(cont));
 #else
         /* ONLY FOR TESTING: This call is properly recursible, but all

Modified: branches/r5rs/sigscheme/test/test-srfi34.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi34.scm	2005-10-03 07:51:04 UTC (rev 1755)
+++ branches/r5rs/sigscheme/test/test-srfi34.scm	2005-10-03 08:00:59 UTC (rev 1756)
@@ -86,38 +86,37 @@
 						  'guard-ret))
 						(raise 1)))))
 
-;(assert-equal? "mixed exception handling test #1" '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 test #2" '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 test #1" '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 test #3" 'zero
-;  (call-with-current-continuation
-;   (lambda (k)
-;     (with-exception-handler (lambda (x)
-;			       (k 'zero))
-;			     (lambda ()
-;			       (guard (condition
-;				       ((positive? condition) 'positive)
-;				       ((negative? condition) 'negative))
-;				      (raise 0)))))))
+(assert-equal? "mixed exception handling test #2" '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 test #3" 'zero
+  (call-with-current-continuation
+   (lambda (k)
+     (with-exception-handler (lambda (x)
+			       (k 'zero))
+			     (lambda ()
+			       (guard (condition
+				       ((positive? condition) 'positive)
+				       ((negative? condition) 'negative))
+				      (raise 0)))))))
 
 (total-report)