[uim-commit] r2824 - in branches/r5rs/sigscheme: . test
yamaken at freedesktop.org
yamaken at freedesktop.org
Fri Jan 6 18:26:04 PST 2006
Author: yamaken
Date: 2006-01-06 18:26:00 -0800 (Fri, 06 Jan 2006)
New Revision: 2824
Modified:
branches/r5rs/sigscheme/env.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/syntax.c
branches/r5rs/sigscheme/test/test-define.scm
branches/r5rs/sigscheme/test/test-exp.scm
branches/r5rs/sigscheme/test/test-srfi8.scm
Log:
* sigscheme/env.c
- (scm_validate_formals, scm_validate_actuals): Add loose but crashless
varidation for !SCM_STRICT_ARGCHECK
* sigscheme/syntax.c
- (scm_s_lambda): Disable formals varidation if !SCM_STRICT_ARGCHECK
- (scm_s_define): Simplify with scm_s_lambda()
* sigscheme/sigscheme.c
- (scm_initialize_internal): Provide "strict-argcheck" if
SCM_STRICT_ARGCHECK
* sigscheme/test/test-define.scm
* sigscheme/test/test-exp.scm
* sigscheme/test/test-srfi8.scm
- Disable strict formals varidation tests when not (provided?
"strict-argcheck")
Modified: branches/r5rs/sigscheme/env.c
===================================================================
--- branches/r5rs/sigscheme/env.c 2006-01-07 01:49:36 UTC (rev 2823)
+++ branches/r5rs/sigscheme/env.c 2006-01-07 02:26:00 UTC (rev 2824)
@@ -270,6 +270,7 @@
int
scm_validate_formals(ScmObj formals)
{
+#if SCM_STRICT_ARGCHECK
ScmObj var;
int len;
DECLARE_INTERNAL_FUNCTION("scm_validate_formals");
@@ -286,6 +287,13 @@
if (SYMBOLP(formals))
return SCM_LISTLEN_ENCODE_DOTTED(len + 1);
return SCM_LISTLEN_ENCODE_ERROR(len);
+#else
+ /* Crashless loose validation:
+ * Regard any non-list object as symbol. Since the lookup operation search
+ * for a variable by EQ, this is safe although loosely allows
+ * R5RS-incompatible code. */
+ return scm_finite_length(formals);
+#endif
}
int
@@ -293,7 +301,14 @@
{
int len;
+#if SCM_STRICT_ARGCHECK
len = scm_length(actuals);
+#else
+ /* Crashless loose validation:
+ * This loop goes infinite if the formals is circular. SigSchme expects
+ * that user codes are sane here. */
+ len = scm_finite_length(actuals);
+#endif
if (SCM_LISTLEN_DOTTEDP(len))
len = SCM_LISTLEN_ENCODE_ERROR(len);
return len;
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2006-01-07 01:49:36 UTC (rev 2823)
+++ branches/r5rs/sigscheme/sigscheme.c 2006-01-07 02:26:00 UTC (rev 2824)
@@ -187,6 +187,9 @@
#if SCM_STRICT_R5RS
scm_provide(MAKE_IMMUTABLE_STRING_COPYING("strict-r5rs"));
#endif
+#if SCM_STRICT_ARGCHECK
+ scm_provide(MAKE_IMMUTABLE_STRING_COPYING("strict-argcheck"));
+#endif
#if SCM_COMPAT_SIOD_BUGS
scm_provide(MAKE_IMMUTABLE_STRING_COPYING("siod-bugs"));
#endif
Modified: branches/r5rs/sigscheme/syntax.c
===================================================================
--- branches/r5rs/sigscheme/syntax.c 2006-01-07 01:49:36 UTC (rev 2823)
+++ branches/r5rs/sigscheme/syntax.c 2006-01-07 02:26:00 UTC (rev 2824)
@@ -361,8 +361,15 @@
{
DECLARE_FUNCTION("lambda", syntax_variadic_1);
+#if SCM_STRICT_ARGCHECK
if (SCM_LISTLEN_ERRORP(scm_validate_formals(formals)))
ERR_OBJ("bad formals", formals);
+#else
+ /* Crashless no-validation:
+ * Regard any non-list object as symbol. Since the lookup operation search
+ * for a variable by EQ, this is safe although loosely allows
+ * R5RS-incompatible code. */
+#endif
if (!CONSP(body))
ERR_OBJ("at least one expression required", body);
@@ -1082,7 +1089,7 @@
ScmObj
scm_s_define(ScmObj var, ScmObj rest, ScmObj env)
{
- ScmObj procname, body, formals;
+ ScmObj procname, body, formals, proc;
DECLARE_FUNCTION("define", syntax_variadic_1);
/*========================================================================
@@ -1106,19 +1113,9 @@
formals = CDR(var);
body = rest;
- if (NULLP(body))
- ERR("define: missing function body");
-#if SCM_STRICT_ARGCHECK
- /* this is not necessary because checked in closure call */
- if (!CONSP(body))
- ERR_OBJ("proper list is required as <body> but got", body);
-#endif
-
ENSURE_SYMBOL(procname);
- if (SCM_LISTLEN_ERRORP(scm_validate_formals(formals)))
- ERR_OBJ("bad formals", formals);
-
- define_internal(procname, MAKE_CLOSURE(CONS(formals, body), env), env);
+ proc = scm_s_lambda(formals, body, env);
+ define_internal(procname, proc, env);
} else {
ERR_OBJ("syntax error", var);
}
Modified: branches/r5rs/sigscheme/test/test-define.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-define.scm 2006-01-07 01:49:36 UTC (rev 2823)
+++ branches/r5rs/sigscheme/test/test-define.scm 2006-01-07 02:26:00 UTC (rev 2824)
@@ -50,9 +50,11 @@
(assert-error "define invalid form #5"
(lambda ()
(define a . 2)))
-(assert-error "define invalid form #6"
- (lambda ()
- (define (f x) . x)))
+(if (and (provided? "sigscheme")
+ (provided? "strict-argcheck"))
+ (assert-error "define invalid form #6"
+ (lambda ()
+ (define (f x) . x))))
; basic define
(define val1 3)
@@ -127,82 +129,85 @@
(assert-equal? "set dot test" '(1 2) (set-dot '()))
-(tn "define function form: boolean as an arg")
-(assert-error (tn) (lambda () (define (f . #t) #t)))
-(assert-error (tn) (lambda () (define (f #t) #t)))
-(assert-error (tn) (lambda () (define (f x #t) #t)))
-(assert-error (tn) (lambda () (define (f #t x) #t)))
-(assert-error (tn) (lambda () (define (f x . #t) #t)))
-(assert-error (tn) (lambda () (define (f #t . x) #t)))
-(assert-error (tn) (lambda () (define (f x y #t) #t)))
-(assert-error (tn) (lambda () (define (f x y . #t) #t)))
-(assert-error (tn) (lambda () (define (f x #t y) #t)))
-(assert-error (tn) (lambda () (define (f x #t . y) #t)))
-(tn "define function form: intger as an arg")
-(assert-error (tn) (lambda () (define (f . 1) #t)))
-(assert-error (tn) (lambda () (define (f 1) #t)))
-(assert-error (tn) (lambda () (define (f x 1) #t)))
-(assert-error (tn) (lambda () (define (f 1 x) #t)))
-(assert-error (tn) (lambda () (define (f x . 1) #t)))
-(assert-error (tn) (lambda () (define (f 1 . x) #t)))
-(assert-error (tn) (lambda () (define (f x y 1) #t)))
-(assert-error (tn) (lambda () (define (f x y . 1) #t)))
-(assert-error (tn) (lambda () (define (f x 1 y) #t)))
-(assert-error (tn) (lambda () (define (f x 1 . y) #t)))
-(tn "define function form: null as an arg")
-(assert-true (tn) (define (f . ()) #t))
-(assert-error (tn) (lambda () (define (f ()) #t)))
-(assert-error (tn) (lambda () (define (f x ()) #t)))
-(assert-error (tn) (lambda () (define (f () x) #t)))
-(assert-true (tn) (define (f x . ()) #t))
-(assert-error (tn) (lambda () (define (f () . x) #t)))
-(assert-error (tn) (lambda () (define (f x y ()) #t)))
-(assert-true (tn) (define (f x y . ()) #t))
-(assert-error (tn) (lambda () (define (f x () y) #t)))
-(assert-error (tn) (lambda () (define (f x () . y) #t)))
-(tn "define function form: pair as an arg")
-(assert-true (tn) (define (f . (a)) #t))
-(assert-error (tn) (lambda () (define (f (a)) #t)))
-(assert-error (tn) (lambda () (define (f x (a)) #t)))
-(assert-error (tn) (lambda () (define (f (a) x) #t)))
-(assert-true (tn) (define (f x . (a)) #t))
-(assert-error (tn) (lambda () (define (f (a) . x) #t)))
-(assert-error (tn) (lambda () (define (f x y (a)) #t)))
-(assert-true (tn) (define (f x y . (a)) #t))
-(assert-error (tn) (lambda () (define (f x (a) y) #t)))
-(assert-error (tn) (lambda () (define (f x (a) . y) #t)))
-(tn "define function form: char as an arg")
-(assert-error (tn) (lambda () (define (f . #\a) #t)))
-(assert-error (tn) (lambda () (define (f #\a) #t)))
-(assert-error (tn) (lambda () (define (f x #\a) #t)))
-(assert-error (tn) (lambda () (define (f #\a x) #t)))
-(assert-error (tn) (lambda () (define (f x . #\a) #t)))
-(assert-error (tn) (lambda () (define (f #\a . x) #t)))
-(assert-error (tn) (lambda () (define (f x y #\a) #t)))
-(assert-error (tn) (lambda () (define (f x y . #\a) #t)))
-(assert-error (tn) (lambda () (define (f x #\a y) #t)))
-(assert-error (tn) (lambda () (define (f x #\a . y) #t)))
-(tn "define function form: string as an arg")
-(assert-error (tn) (lambda () (define (f . "a") #t)))
-(assert-error (tn) (lambda () (define (f "a") #t)))
-(assert-error (tn) (lambda () (define (f x "a") #t)))
-(assert-error (tn) (lambda () (define (f "a" x) #t)))
-(assert-error (tn) (lambda () (define (f x . "a") #t)))
-(assert-error (tn) (lambda () (define (f "a" . x) #t)))
-(assert-error (tn) (lambda () (define (f x y "a") #t)))
-(assert-error (tn) (lambda () (define (f x y . "a") #t)))
-(assert-error (tn) (lambda () (define (f x "a" y) #t)))
-(assert-error (tn) (lambda () (define (f x "a" . y) #t)))
-(tn "define function form: vector as an arg")
-(assert-error (tn) (lambda () (define (f . #(a)) #t)))
-(assert-error (tn) (lambda () (define (f #(a)) #t)))
-(assert-error (tn) (lambda () (define (f x #(a)) #t)))
-(assert-error (tn) (lambda () (define (f #(a) x) #t)))
-(assert-error (tn) (lambda () (define (f x . #(a)) #t)))
-(assert-error (tn) (lambda () (define (f #(a) . x) #t)))
-(assert-error (tn) (lambda () (define (f x y #(a)) #t)))
-(assert-error (tn) (lambda () (define (f x y . #(a)) #t)))
-(assert-error (tn) (lambda () (define (f x #(a) y) #t)))
-(assert-error (tn) (lambda () (define (f x #(a) . y) #t)))
+(if (and (provided? "sigscheme")
+ (provided? "strict-argcheck"))
+ (begin
+ (tn "define function form: boolean as an arg")
+ (assert-error (tn) (lambda () (define (f . #t) #t)))
+ (assert-error (tn) (lambda () (define (f #t) #t)))
+ (assert-error (tn) (lambda () (define (f x #t) #t)))
+ (assert-error (tn) (lambda () (define (f #t x) #t)))
+ (assert-error (tn) (lambda () (define (f x . #t) #t)))
+ (assert-error (tn) (lambda () (define (f #t . x) #t)))
+ (assert-error (tn) (lambda () (define (f x y #t) #t)))
+ (assert-error (tn) (lambda () (define (f x y . #t) #t)))
+ (assert-error (tn) (lambda () (define (f x #t y) #t)))
+ (assert-error (tn) (lambda () (define (f x #t . y) #t)))
+ (tn "define function form: intger as an arg")
+ (assert-error (tn) (lambda () (define (f . 1) #t)))
+ (assert-error (tn) (lambda () (define (f 1) #t)))
+ (assert-error (tn) (lambda () (define (f x 1) #t)))
+ (assert-error (tn) (lambda () (define (f 1 x) #t)))
+ (assert-error (tn) (lambda () (define (f x . 1) #t)))
+ (assert-error (tn) (lambda () (define (f 1 . x) #t)))
+ (assert-error (tn) (lambda () (define (f x y 1) #t)))
+ (assert-error (tn) (lambda () (define (f x y . 1) #t)))
+ (assert-error (tn) (lambda () (define (f x 1 y) #t)))
+ (assert-error (tn) (lambda () (define (f x 1 . y) #t)))
+ (tn "define function form: null as an arg")
+ (assert-true (tn) (define (f . ()) #t))
+ (assert-error (tn) (lambda () (define (f ()) #t)))
+ (assert-error (tn) (lambda () (define (f x ()) #t)))
+ (assert-error (tn) (lambda () (define (f () x) #t)))
+ (assert-true (tn) (define (f x . ()) #t))
+ (assert-error (tn) (lambda () (define (f () . x) #t)))
+ (assert-error (tn) (lambda () (define (f x y ()) #t)))
+ (assert-true (tn) (define (f x y . ()) #t))
+ (assert-error (tn) (lambda () (define (f x () y) #t)))
+ (assert-error (tn) (lambda () (define (f x () . y) #t)))
+ (tn "define function form: pair as an arg")
+ (assert-true (tn) (define (f . (a)) #t))
+ (assert-error (tn) (lambda () (define (f (a)) #t)))
+ (assert-error (tn) (lambda () (define (f x (a)) #t)))
+ (assert-error (tn) (lambda () (define (f (a) x) #t)))
+ (assert-true (tn) (define (f x . (a)) #t))
+ (assert-error (tn) (lambda () (define (f (a) . x) #t)))
+ (assert-error (tn) (lambda () (define (f x y (a)) #t)))
+ (assert-true (tn) (define (f x y . (a)) #t))
+ (assert-error (tn) (lambda () (define (f x (a) y) #t)))
+ (assert-error (tn) (lambda () (define (f x (a) . y) #t)))
+ (tn "define function form: char as an arg")
+ (assert-error (tn) (lambda () (define (f . #\a) #t)))
+ (assert-error (tn) (lambda () (define (f #\a) #t)))
+ (assert-error (tn) (lambda () (define (f x #\a) #t)))
+ (assert-error (tn) (lambda () (define (f #\a x) #t)))
+ (assert-error (tn) (lambda () (define (f x . #\a) #t)))
+ (assert-error (tn) (lambda () (define (f #\a . x) #t)))
+ (assert-error (tn) (lambda () (define (f x y #\a) #t)))
+ (assert-error (tn) (lambda () (define (f x y . #\a) #t)))
+ (assert-error (tn) (lambda () (define (f x #\a y) #t)))
+ (assert-error (tn) (lambda () (define (f x #\a . y) #t)))
+ (tn "define function form: string as an arg")
+ (assert-error (tn) (lambda () (define (f . "a") #t)))
+ (assert-error (tn) (lambda () (define (f "a") #t)))
+ (assert-error (tn) (lambda () (define (f x "a") #t)))
+ (assert-error (tn) (lambda () (define (f "a" x) #t)))
+ (assert-error (tn) (lambda () (define (f x . "a") #t)))
+ (assert-error (tn) (lambda () (define (f "a" . x) #t)))
+ (assert-error (tn) (lambda () (define (f x y "a") #t)))
+ (assert-error (tn) (lambda () (define (f x y . "a") #t)))
+ (assert-error (tn) (lambda () (define (f x "a" y) #t)))
+ (assert-error (tn) (lambda () (define (f x "a" . y) #t)))
+ (tn "define function form: vector as an arg")
+ (assert-error (tn) (lambda () (define (f . #(a)) #t)))
+ (assert-error (tn) (lambda () (define (f #(a)) #t)))
+ (assert-error (tn) (lambda () (define (f x #(a)) #t)))
+ (assert-error (tn) (lambda () (define (f #(a) x) #t)))
+ (assert-error (tn) (lambda () (define (f x . #(a)) #t)))
+ (assert-error (tn) (lambda () (define (f #(a) . x) #t)))
+ (assert-error (tn) (lambda () (define (f x y #(a)) #t)))
+ (assert-error (tn) (lambda () (define (f x y . #(a)) #t)))
+ (assert-error (tn) (lambda () (define (f x #(a) y) #t)))
+ (assert-error (tn) (lambda () (define (f x #(a) . y) #t)))))
(total-report)
Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm 2006-01-07 01:49:36 UTC (rev 2823)
+++ branches/r5rs/sigscheme/test/test-exp.scm 2006-01-07 02:26:00 UTC (rev 2824)
@@ -56,76 +56,79 @@
(assert-equal? "basic lambda test10" 2 ((lambda (x y . z) y) 1 2))
(assert-equal? "basic lambda test11" '() ((lambda (x y . z) z) 1 2))
-(tn "lambda invalid formals: boolean as an arg")
-(assert-error (tn) (lambda () (lambda (#t) #t)))
-(assert-error (tn) (lambda () (lambda (x #t) #t)))
-(assert-error (tn) (lambda () (lambda (#t x) #t)))
-(assert-error (tn) (lambda () (lambda (x . #t) #t)))
-(assert-error (tn) (lambda () (lambda (#t . x) #t)))
-(assert-error (tn) (lambda () (lambda (x y #t) #t)))
-(assert-error (tn) (lambda () (lambda (x y . #t) #t)))
-(assert-error (tn) (lambda () (lambda (x #t y) #t)))
-(assert-error (tn) (lambda () (lambda (x #t . y) #t)))
-(tn "lambda invalid formals: intger as an arg")
-(assert-error (tn) (lambda () (lambda (1) #t)))
-(assert-error (tn) (lambda () (lambda (x 1) #t)))
-(assert-error (tn) (lambda () (lambda (1 x) #t)))
-(assert-error (tn) (lambda () (lambda (x . 1) #t)))
-(assert-error (tn) (lambda () (lambda (1 . x) #t)))
-(assert-error (tn) (lambda () (lambda (x y 1) #t)))
-(assert-error (tn) (lambda () (lambda (x y . 1) #t)))
-(assert-error (tn) (lambda () (lambda (x 1 y) #t)))
-(assert-error (tn) (lambda () (lambda (x 1 . y) #t)))
-(tn "lambda invalid formals: null as an arg")
-(assert-error (tn) (lambda () (lambda (()) #t)))
-(assert-error (tn) (lambda () (lambda (x ()) #t)))
-(assert-error (tn) (lambda () (lambda (() x) #t)))
-(assert-true (tn) (lambda (x . ()) #t))
-(assert-error (tn) (lambda () (lambda (() . x) #t)))
-(assert-error (tn) (lambda () (lambda (x y ()) #t)))
-(assert-true (tn) (lambda (x y . ()) #t))
-(assert-error (tn) (lambda () (lambda (x () y) #t)))
-(assert-error (tn) (lambda () (lambda (x () . y) #t)))
-(tn "lambda invalid formals: pair as an arg")
-(assert-error (tn) (lambda () (lambda ((a)) #t)))
-(assert-error (tn) (lambda () (lambda (x (a)) #t)))
-(assert-error (tn) (lambda () (lambda ((a) x) #t)))
-(assert-true (tn) (lambda (x . (a)) #t))
-(assert-error (tn) (lambda () (lambda ((a) . x) #t)))
-(assert-error (tn) (lambda () (lambda (x y (a)) #t)))
-(assert-true (tn) (lambda (x y . (a)) #t))
-(assert-error (tn) (lambda () (lambda (x (a) y) #t)))
-(assert-error (tn) (lambda () (lambda (x (a) . y) #t)))
-(tn "lambda invalid formals: char as an arg")
-(assert-error (tn) (lambda () (lambda (#\a) #t)))
-(assert-error (tn) (lambda () (lambda (x #\a) #t)))
-(assert-error (tn) (lambda () (lambda (#\a x) #t)))
-(assert-error (tn) (lambda () (lambda (x . #\a) #t)))
-(assert-error (tn) (lambda () (lambda (#\a . x) #t)))
-(assert-error (tn) (lambda () (lambda (x y #\a) #t)))
-(assert-error (tn) (lambda () (lambda (x y . #\a) #t)))
-(assert-error (tn) (lambda () (lambda (x #\a y) #t)))
-(assert-error (tn) (lambda () (lambda (x #\a . y) #t)))
-(tn "lambda invalid formals: string as an arg")
-(assert-error (tn) (lambda () (lambda ("a") #t)))
-(assert-error (tn) (lambda () (lambda (x "a") #t)))
-(assert-error (tn) (lambda () (lambda ("a" x) #t)))
-(assert-error (tn) (lambda () (lambda (x . "a") #t)))
-(assert-error (tn) (lambda () (lambda ("a" . x) #t)))
-(assert-error (tn) (lambda () (lambda (x y "a") #t)))
-(assert-error (tn) (lambda () (lambda (x y . "a") #t)))
-(assert-error (tn) (lambda () (lambda (x "a" y) #t)))
-(assert-error (tn) (lambda () (lambda (x "a" . y) #t)))
-(tn "lambda invalid formals: vector as an arg")
-(assert-error (tn) (lambda () (lambda (#(a)) #t)))
-(assert-error (tn) (lambda () (lambda (x #(a)) #t)))
-(assert-error (tn) (lambda () (lambda (#(a) x) #t)))
-(assert-error (tn) (lambda () (lambda (x . #(a)) #t)))
-(assert-error (tn) (lambda () (lambda (#(a) . x) #t)))
-(assert-error (tn) (lambda () (lambda (x y #(a)) #t)))
-(assert-error (tn) (lambda () (lambda (x y . #(a)) #t)))
-(assert-error (tn) (lambda () (lambda (x #(a) y) #t)))
-(assert-error (tn) (lambda () (lambda (x #(a) . y) #t)))
+(if (and (provided? "sigscheme")
+ (provided? "strict-argcheck"))
+ (begin
+ (tn "lambda invalid formals: boolean as an arg")
+ (assert-error (tn) (lambda () (lambda (#t) #t)))
+ (assert-error (tn) (lambda () (lambda (x #t) #t)))
+ (assert-error (tn) (lambda () (lambda (#t x) #t)))
+ (assert-error (tn) (lambda () (lambda (x . #t) #t)))
+ (assert-error (tn) (lambda () (lambda (#t . x) #t)))
+ (assert-error (tn) (lambda () (lambda (x y #t) #t)))
+ (assert-error (tn) (lambda () (lambda (x y . #t) #t)))
+ (assert-error (tn) (lambda () (lambda (x #t y) #t)))
+ (assert-error (tn) (lambda () (lambda (x #t . y) #t)))
+ (tn "lambda invalid formals: intger as an arg")
+ (assert-error (tn) (lambda () (lambda (1) #t)))
+ (assert-error (tn) (lambda () (lambda (x 1) #t)))
+ (assert-error (tn) (lambda () (lambda (1 x) #t)))
+ (assert-error (tn) (lambda () (lambda (x . 1) #t)))
+ (assert-error (tn) (lambda () (lambda (1 . x) #t)))
+ (assert-error (tn) (lambda () (lambda (x y 1) #t)))
+ (assert-error (tn) (lambda () (lambda (x y . 1) #t)))
+ (assert-error (tn) (lambda () (lambda (x 1 y) #t)))
+ (assert-error (tn) (lambda () (lambda (x 1 . y) #t)))
+ (tn "lambda invalid formals: null as an arg")
+ (assert-error (tn) (lambda () (lambda (()) #t)))
+ (assert-error (tn) (lambda () (lambda (x ()) #t)))
+ (assert-error (tn) (lambda () (lambda (() x) #t)))
+ (assert-true (tn) (lambda (x . ()) #t))
+ (assert-error (tn) (lambda () (lambda (() . x) #t)))
+ (assert-error (tn) (lambda () (lambda (x y ()) #t)))
+ (assert-true (tn) (lambda (x y . ()) #t))
+ (assert-error (tn) (lambda () (lambda (x () y) #t)))
+ (assert-error (tn) (lambda () (lambda (x () . y) #t)))
+ (tn "lambda invalid formals: pair as an arg")
+ (assert-error (tn) (lambda () (lambda ((a)) #t)))
+ (assert-error (tn) (lambda () (lambda (x (a)) #t)))
+ (assert-error (tn) (lambda () (lambda ((a) x) #t)))
+ (assert-true (tn) (lambda (x . (a)) #t))
+ (assert-error (tn) (lambda () (lambda ((a) . x) #t)))
+ (assert-error (tn) (lambda () (lambda (x y (a)) #t)))
+ (assert-true (tn) (lambda (x y . (a)) #t))
+ (assert-error (tn) (lambda () (lambda (x (a) y) #t)))
+ (assert-error (tn) (lambda () (lambda (x (a) . y) #t)))
+ (tn "lambda invalid formals: char as an arg")
+ (assert-error (tn) (lambda () (lambda (#\a) #t)))
+ (assert-error (tn) (lambda () (lambda (x #\a) #t)))
+ (assert-error (tn) (lambda () (lambda (#\a x) #t)))
+ (assert-error (tn) (lambda () (lambda (x . #\a) #t)))
+ (assert-error (tn) (lambda () (lambda (#\a . x) #t)))
+ (assert-error (tn) (lambda () (lambda (x y #\a) #t)))
+ (assert-error (tn) (lambda () (lambda (x y . #\a) #t)))
+ (assert-error (tn) (lambda () (lambda (x #\a y) #t)))
+ (assert-error (tn) (lambda () (lambda (x #\a . y) #t)))
+ (tn "lambda invalid formals: string as an arg")
+ (assert-error (tn) (lambda () (lambda ("a") #t)))
+ (assert-error (tn) (lambda () (lambda (x "a") #t)))
+ (assert-error (tn) (lambda () (lambda ("a" x) #t)))
+ (assert-error (tn) (lambda () (lambda (x . "a") #t)))
+ (assert-error (tn) (lambda () (lambda ("a" . x) #t)))
+ (assert-error (tn) (lambda () (lambda (x y "a") #t)))
+ (assert-error (tn) (lambda () (lambda (x y . "a") #t)))
+ (assert-error (tn) (lambda () (lambda (x "a" y) #t)))
+ (assert-error (tn) (lambda () (lambda (x "a" . y) #t)))
+ (tn "lambda invalid formals: vector as an arg")
+ (assert-error (tn) (lambda () (lambda (#(a)) #t)))
+ (assert-error (tn) (lambda () (lambda (x #(a)) #t)))
+ (assert-error (tn) (lambda () (lambda (#(a) x) #t)))
+ (assert-error (tn) (lambda () (lambda (x . #(a)) #t)))
+ (assert-error (tn) (lambda () (lambda (#(a) . x) #t)))
+ (assert-error (tn) (lambda () (lambda (x y #(a)) #t)))
+ (assert-error (tn) (lambda () (lambda (x y . #(a)) #t)))
+ (assert-error (tn) (lambda () (lambda (x #(a) y) #t)))
+ (assert-error (tn) (lambda () (lambda (x #(a) . y) #t)))))
;;
;; if
Modified: branches/r5rs/sigscheme/test/test-srfi8.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi8.scm 2006-01-07 01:49:36 UTC (rev 2823)
+++ branches/r5rs/sigscheme/test/test-srfi8.scm 2006-01-07 02:26:00 UTC (rev 2824)
@@ -96,75 +96,78 @@
(assert-equal? (tn) '(0 1 (2 3))
(receive (x y . rest) (values 0 1 2 3) (list x y rest)))
-(tn "receive invalid formals: boolean as an arg")
-(assert-error (tn) (lambda () (receive (#t) #t #t)))
-(assert-error (tn) (lambda () (receive (x #t) #t #t)))
-(assert-error (tn) (lambda () (receive (#t x) #t #t)))
-(assert-error (tn) (lambda () (receive (x . #t) #t #t)))
-(assert-error (tn) (lambda () (receive (#t . x) #t #t)))
-(assert-error (tn) (lambda () (receive (x y #t) #t #t)))
-(assert-error (tn) (lambda () (receive (x y . #t) #t #t)))
-(assert-error (tn) (lambda () (receive (x #t y) #t #t)))
-(assert-error (tn) (lambda () (receive (x #t . y) #t #t)))
-(tn "receive invalid formals: intger as an arg")
-(assert-error (tn) (lambda () (receive (1) #t #t)))
-(assert-error (tn) (lambda () (receive (x 1) #t #t)))
-(assert-error (tn) (lambda () (receive (1 x) #t #t)))
-(assert-error (tn) (lambda () (receive (x . 1) #t #t)))
-(assert-error (tn) (lambda () (receive (1 . x) #t #t)))
-(assert-error (tn) (lambda () (receive (x y 1) #t #t)))
-(assert-error (tn) (lambda () (receive (x y . 1) #t #t)))
-(assert-error (tn) (lambda () (receive (x 1 y) #t #t)))
-(assert-error (tn) (lambda () (receive (x 1 . y) #t #t)))
-(tn "receive invalid formals: null as an arg")
-(assert-error (tn) (lambda () (receive (()) #t #t)))
-(assert-error (tn) (lambda () (receive (x ()) #t #t)))
-(assert-error (tn) (lambda () (receive (() x) #t #t)))
-(assert-true (tn) (receive (x . ()) #t x))
-(assert-error (tn) (lambda () (receive (() . x) #t #t)))
-(assert-error (tn) (lambda () (receive (x y ()) #t #t)))
-(assert-error (tn) (lambda () (receive (x y . ()) #t x)))
-(assert-error (tn) (lambda () (receive (x () y) #t #t)))
-(assert-error (tn) (lambda () (receive (x () . y) #t #t)))
-(tn "receive invalid formals: pair as an arg")
-(assert-error (tn) (lambda () (receive ((a)) #t #t)))
-(assert-error (tn) (lambda () (receive (x (a)) #t #t)))
-(assert-error (tn) (lambda () (receive ((a) x) #t #t)))
-(assert-error (tn) (lambda () (receive (x . (a)) #t x)))
-(assert-error (tn) (lambda () (receive ((a) . x) #t #t)))
-(assert-error (tn) (lambda () (receive (x y (a)) #t #t)))
-(assert-true (tn) (lambda () (receive (x y . (a)) #t x)))
-(assert-error (tn) (lambda () (receive (x (a) y) #t #t)))
-(assert-error (tn) (lambda () (receive (x (a) . y) #t #t)))
-(tn "receive invalid formals: char as an arg")
-(assert-error (tn) (lambda () (receive (#\a) #t #t)))
-(assert-error (tn) (lambda () (receive (x #\a) #t #t)))
-(assert-error (tn) (lambda () (receive (#\a x) #t #t)))
-(assert-error (tn) (lambda () (receive (x . #\a) #t #t)))
-(assert-error (tn) (lambda () (receive (#\a . x) #t #t)))
-(assert-error (tn) (lambda () (receive (x y #\a) #t #t)))
-(assert-error (tn) (lambda () (receive (x y . #\a) #t #t)))
-(assert-error (tn) (lambda () (receive (x #\a y) #t #t)))
-(assert-error (tn) (lambda () (receive (x #\a . y) #t #t)))
-(tn "receive invalid formals: string as an arg")
-(assert-error (tn) (lambda () (receive ("a") #t #t)))
-(assert-error (tn) (lambda () (receive (x "a") #t #t)))
-(assert-error (tn) (lambda () (receive ("a" x) #t #t)))
-(assert-error (tn) (lambda () (receive (x . "a") #t #t)))
-(assert-error (tn) (lambda () (receive ("a" . x) #t #t)))
-(assert-error (tn) (lambda () (receive (x y "a") #t #t)))
-(assert-error (tn) (lambda () (receive (x y . "a") #t #t)))
-(assert-error (tn) (lambda () (receive (x "a" y) #t #t)))
-(assert-error (tn) (lambda () (receive (x "a" . y) #t #t)))
-(tn "receive invalid formals: vector as an arg")
-(assert-error (tn) (lambda () (receive (#(a)) #t #t)))
-(assert-error (tn) (lambda () (receive (x #(a)) #t #t)))
-(assert-error (tn) (lambda () (receive (#(a) x) #t #t)))
-(assert-error (tn) (lambda () (receive (x . #(a)) #t #t)))
-(assert-error (tn) (lambda () (receive (#(a) . x) #t #t)))
-(assert-error (tn) (lambda () (receive (x y #(a)) #t #t)))
-(assert-error (tn) (lambda () (receive (x y . #(a)) #t #t)))
-(assert-error (tn) (lambda () (receive (x #(a) y) #t #t)))
-(assert-error (tn) (lambda () (receive (x #(a) . y) #t #t)))
+(if (and (provided? "sigscheme")
+ (provided? "strict-argcheck"))
+ (begin
+ (tn "receive invalid formals: boolean as an arg")
+ (assert-error (tn) (lambda () (receive (#t) #t #t)))
+ (assert-error (tn) (lambda () (receive (x #t) #t #t)))
+ (assert-error (tn) (lambda () (receive (#t x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x . #t) #t #t)))
+ (assert-error (tn) (lambda () (receive (#t . x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y #t) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y . #t) #t #t)))
+ (assert-error (tn) (lambda () (receive (x #t y) #t #t)))
+ (assert-error (tn) (lambda () (receive (x #t . y) #t #t)))
+ (tn "receive invalid formals: intger as an arg")
+ (assert-error (tn) (lambda () (receive (1) #t #t)))
+ (assert-error (tn) (lambda () (receive (x 1) #t #t)))
+ (assert-error (tn) (lambda () (receive (1 x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x . 1) #t #t)))
+ (assert-error (tn) (lambda () (receive (1 . x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y 1) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y . 1) #t #t)))
+ (assert-error (tn) (lambda () (receive (x 1 y) #t #t)))
+ (assert-error (tn) (lambda () (receive (x 1 . y) #t #t)))
+ (tn "receive invalid formals: null as an arg")
+ (assert-error (tn) (lambda () (receive (()) #t #t)))
+ (assert-error (tn) (lambda () (receive (x ()) #t #t)))
+ (assert-error (tn) (lambda () (receive (() x) #t #t)))
+ (assert-true (tn) (receive (x . ()) #t x))
+ (assert-error (tn) (lambda () (receive (() . x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y ()) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y . ()) #t x)))
+ (assert-error (tn) (lambda () (receive (x () y) #t #t)))
+ (assert-error (tn) (lambda () (receive (x () . y) #t #t)))
+ (tn "receive invalid formals: pair as an arg")
+ (assert-error (tn) (lambda () (receive ((a)) #t #t)))
+ (assert-error (tn) (lambda () (receive (x (a)) #t #t)))
+ (assert-error (tn) (lambda () (receive ((a) x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x . (a)) #t x)))
+ (assert-error (tn) (lambda () (receive ((a) . x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y (a)) #t #t)))
+ (assert-true (tn) (lambda () (receive (x y . (a)) #t x)))
+ (assert-error (tn) (lambda () (receive (x (a) y) #t #t)))
+ (assert-error (tn) (lambda () (receive (x (a) . y) #t #t)))
+ (tn "receive invalid formals: char as an arg")
+ (assert-error (tn) (lambda () (receive (#\a) #t #t)))
+ (assert-error (tn) (lambda () (receive (x #\a) #t #t)))
+ (assert-error (tn) (lambda () (receive (#\a x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x . #\a) #t #t)))
+ (assert-error (tn) (lambda () (receive (#\a . x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y #\a) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y . #\a) #t #t)))
+ (assert-error (tn) (lambda () (receive (x #\a y) #t #t)))
+ (assert-error (tn) (lambda () (receive (x #\a . y) #t #t)))
+ (tn "receive invalid formals: string as an arg")
+ (assert-error (tn) (lambda () (receive ("a") #t #t)))
+ (assert-error (tn) (lambda () (receive (x "a") #t #t)))
+ (assert-error (tn) (lambda () (receive ("a" x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x . "a") #t #t)))
+ (assert-error (tn) (lambda () (receive ("a" . x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y "a") #t #t)))
+ (assert-error (tn) (lambda () (receive (x y . "a") #t #t)))
+ (assert-error (tn) (lambda () (receive (x "a" y) #t #t)))
+ (assert-error (tn) (lambda () (receive (x "a" . y) #t #t)))
+ (tn "receive invalid formals: vector as an arg")
+ (assert-error (tn) (lambda () (receive (#(a)) #t #t)))
+ (assert-error (tn) (lambda () (receive (x #(a)) #t #t)))
+ (assert-error (tn) (lambda () (receive (#(a) x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x . #(a)) #t #t)))
+ (assert-error (tn) (lambda () (receive (#(a) . x) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y #(a)) #t #t)))
+ (assert-error (tn) (lambda () (receive (x y . #(a)) #t #t)))
+ (assert-error (tn) (lambda () (receive (x #(a) y) #t #t)))
+ (assert-error (tn) (lambda () (receive (x #(a) . y) #t #t)))))
(total-report)
More information about the uim-commit
mailing list