[uim-commit] r2814 - in branches/r5rs/sigscheme: . test
yamaken at freedesktop.org
yamaken at freedesktop.org
Fri Jan 6 13:42:50 PST 2006
Author: yamaken
Date: 2006-01-06 13:42:44 -0800 (Fri, 06 Jan 2006)
New Revision: 2814
Modified:
branches/r5rs/sigscheme/env.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemeinternal.h
branches/r5rs/sigscheme/syntax.c
branches/r5rs/sigscheme/test/test-eval.scm
branches/r5rs/sigscheme/test/test-syntax.scm
Log:
* This commit remove overhead on environment lookup and extension
* sigscheme/sigscheme.h
- (SCM_VALID_ENVP, SCM_LISTLEN_ERRORP): New macro
* sigscheme/sigschemeinternal.h
- (VALID_ENVP, ENSURE_VALID_ENV, SCM_LISTLEN_ENCODE_ERROR): New
macro
- (scm_valid_environmentp, scm_valid_environment_extensionp,
scm_valid_environment_extension_lengthp, scm_validate_formals,
scm_validate_actuals): New function decl
* sigscheme/env.c
- Add description about frames and responsibility for keeping
validity
- (TRUSTED_ENVP): New macro
- (scm_extend_environment):
* Remove obsolete description about vals
* Remove lookup-time validity check
- (scm_add_environment):
* Add assertion for env object
* Replace broken env detection with false assertion
- (scm_lookup_environment):
* Add assertions
* Replace CONSP() with !NULLP() for performance. This is safe by
the preconditions
- (lookup_frame):
* Remove lookup-time validity check
* Add assertions
- (scm_valid_environmentp, scm_valid_environment_extensionp,
scm_valid_environment_extension_lengthp, scm_validate_formals,
scm_validate_actuals): New function
- (valid_framep): New static function
* sigscheme/eval.c
- (call_closure):
* Add arg 'suppress_eval'
* Move args evaluation responsibility from call()
* Add validation for formals and actuals
* Fix no-check for superfluous args on null formals
- (call): Follow the change of call_closure() and map_eval()
- (scm_p_eval): Add ENSURE_VALID_ENV() to reject invalid hand-maid env
- (map_eval): Add output arg 'args_len' for efficient actuals
validation
* sigscheme/syntax.c
- (scm_s_lambda): Add validation for formals
* sigscheme/test/test-eval.scm
- Add tests for hand-maid environment objects
* sigscheme/test/test-syntax.scm
- Remove a miswritten test
Modified: branches/r5rs/sigscheme/env.c
===================================================================
--- branches/r5rs/sigscheme/env.c 2006-01-06 17:13:27 UTC (rev 2813)
+++ branches/r5rs/sigscheme/env.c 2006-01-06 21:42:44 UTC (rev 2814)
@@ -39,8 +39,29 @@
* (val1 val2 val3 ...))
* Env = (Frame1 Frame2 Frame3 ...)
*
+ * Other 2 forms are also used to handle dotted args.
+ *
+ * Frame = (cons (var1 var2 var3 . rest1)
+ * (val1 val2 val3 var4 var5 ...))
+ *
+ * Frame = (cons rest2
+ * (val1 val2 val3 var4 var5 ...))
+ *
+ * In this case, rest1 is bound to (var4 var5 ...) and rest2 is bound to
+ * (val1 val2 val3 var4 var5 ...).
+ *
* The environment object should not be manipulated manually, to allow
- * replacing with another implementation. Use the three function interface.
+ * replacing with another implementation. Use the function interfaces.
+ *
+ * To ensure valid use of the environment objects is environment
+ * constructor's responsibility. i.e. Any lookup operations assume that the
+ * environment object is valid. To keep the assumption true, any environemnt
+ * object modification and injection from user code must be
+ * validated. Although the validation for the injection may cost high,
+ * ordinary code only use (interaction-environment) and other R5RS
+ * environment specifiers. Since these 'trusted' specifiers can cheaply be
+ * identified, the validation cost is also. The validation can reject any
+ * hand-maid invalid environment objects.
*/
/*=======================================
@@ -60,6 +81,9 @@
/*=======================================
File Local Macro Declarations
=======================================*/
+#define TRUSTED_ENVP(env) (EQ(env, SCM_INTERACTION_ENV) \
+ || EQ(env, SCM_R5RS_ENV) \
+ || EQ(env, SCM_NULL_ENV))
/*=======================================
Variable Declarations
@@ -69,6 +93,7 @@
File Local Function Declarations
=======================================*/
static ScmRef lookup_frame(ScmObj var, ScmObj frame);
+static scm_bool valid_framep(ScmObj frame);
/*=======================================
Function Implementations
@@ -78,37 +103,22 @@
*
* @a vars and @a vals must surely be a list.
*
- * @param vars Symbol list as variable names of new frame. It accepts dot list
- * to handle function arguments directly.
- * @param vals Arbitrary Scheme object list as values of new frame. Side
- * effect: destructively modifyies the vals when vars is a dot
- * list.
+ * @param vars Symbol list as variable names of new frame. It accepts dotted
+ * list to handle function arguments directly.
+ * @param vals Arbitrary Scheme object list as values of new frame.
+ *
* @see scm_eval()
*/
ScmObj
scm_extend_environment(ScmObj vars, ScmObj vals, ScmObj env)
{
- ScmObj frame, rest_vars, rest_vals;
+ ScmObj frame;
DECLARE_INTERNAL_FUNCTION("scm_extend_environment");
-#if SCM_STRICT_ARGCHECK
- if (!LISTP(env))
- ERR("broken environment");
+ SCM_ASSERT(scm_valid_environment_extensionp(vars, vals));
+ SCM_ASSERT(VALID_ENVP(env));
- for (rest_vars = vars, rest_vals = vals;
- CONSP(rest_vars) && !NULLP(rest_vals);
- rest_vars = CDR(rest_vars), rest_vals = CDR(rest_vals))
- {
- if (!SYMBOLP(CAR(rest_vars)))
- break;
- }
- if (!(NULLP(rest_vars) || SYMBOLP(rest_vars)))
- ERR_OBJ("broken environment extension", rest_vars);
-#endif /* SCM_STRICT_ARGCHECK */
-
- /* create new frame */
frame = CONS(vars, vals);
-
return CONS(frame, env);
}
@@ -121,6 +131,7 @@
DECLARE_INTERNAL_FUNCTION("scm_add_environment");
SCM_ASSERT(SYMBOLP(var));
+ SCM_ASSERT(VALID_ENVP(env));
/* add (var, val) pair to the newest frame in env */
if (NULLP(env)) {
@@ -134,7 +145,7 @@
SET_CAR(env, newest_frame);
} else {
- ERR_OBJ("broken environent", env);
+ SCM_ASSERT(scm_false);
}
return env;
}
@@ -151,19 +162,18 @@
ScmRef ref;
DECLARE_INTERNAL_FUNCTION("scm_lookup_environment");
+ SCM_ASSERT(SYMBOLP(var));
+ SCM_ASSERT(VALID_ENVP(env));
+
/* lookup in frames */
- for (; CONSP(env); env = CDR(env)) {
+ for (; !NULLP(env); env = CDR(env)) {
frame = CAR(env);
ref = lookup_frame(var, frame);
if (ref != SCM_INVALID_REF)
return ref;
}
+ SCM_ASSERT(NULLP(env));
-#if SCM_STRICT_ARGCHECK
- if (!NULLP(env))
- ERR_OBJ("broken environent", env);
-#endif
-
return SCM_INVALID_REF;
}
@@ -175,30 +185,117 @@
ScmRef vals;
DECLARE_INTERNAL_FUNCTION("lookup_frame");
-#if SCM_STRICT_ARGCHECK
- ENSURE_SYMBOL(var);
- ENSURE_CONS(frame);
-#endif
+ SCM_ASSERT(SYMBOLP(var));
+ SCM_ASSERT(valid_framep(frame));
for (vars = CAR(frame), vals = REF_CDR(frame);
CONSP(vars);
vars = CDR(vars), vals = REF_CDR(DEREF(vals)))
{
-#if SCM_STRICT_ARGCHECK
- /*
- * This is required to reject hand-maid broken frame:
- * (eval '(+ x y) '((x . 4)
- * (y . 6)))
- *
- * It can be removed once the typed environment object is implemented.
- */
- ENSURE_CONS(DEREF(vals));
-#endif
if (EQ(var, CAR(vars)))
return REF_CAR(DEREF(vals));
}
- if (EQ(vars, var))
+ /* dotted list */
+ if (EQ(var, vars))
return vals;
return SCM_INVALID_REF;
}
+
+/*
+ * Validators
+ */
+scm_bool
+scm_valid_environmentp(ScmObj env)
+{
+ ScmObj frame, rest;
+ DECLARE_INTERNAL_FUNCTION("scm_valid_environmentp");
+
+ if (TRUSTED_ENVP(env))
+ return scm_true;
+
+ /*
+ * The env is extended and untrusted. Since this case rarely occurs in
+ * ordinary codes, the expensive validation cost is acceptable.
+ */
+
+ if (!PROPER_LISTP(env))
+ return scm_false;
+ for (rest = env; !NULLP(rest); rest = CDR(rest)) {
+ frame = CAR(rest);
+ if (!valid_framep(frame))
+ return scm_false;
+ }
+
+ return scm_true;
+}
+
+static scm_bool
+valid_framep(ScmObj frame)
+{
+ ScmObj vars, vals;
+ DECLARE_INTERNAL_FUNCTION("valid_framep");
+
+ if (CONSP(frame)) {
+ vars = CAR(frame);
+ vals = CDR(frame);
+ if (scm_valid_environment_extensionp(vars, vals))
+ return scm_true;
+ }
+ return scm_false;
+}
+
+scm_bool
+scm_valid_environment_extensionp(ScmObj formals, ScmObj actuals)
+{
+ int formals_len, actuals_len;
+
+ formals_len = scm_validate_formals(formals);
+ actuals_len = scm_validate_actuals(actuals);
+ return scm_valid_environment_extension_lengthp(formals_len, actuals_len);
+}
+
+/* formals_len must be validated by scm_validate_formals() prior to here */
+scm_bool
+scm_valid_environment_extension_lengthp(int formals_len, int actuals_len)
+{
+ if (SCM_LISTLEN_ERRORP(formals_len) || !SCM_LISTLEN_PROPERP(actuals_len))
+ return scm_false;
+ if (SCM_LISTLEN_DOTTEDP(formals_len)) {
+ formals_len = SCM_LISTLEN_BEFORE_DOT(formals_len);
+ return (formals_len <= actuals_len);
+ }
+ return (formals_len == actuals_len);
+}
+
+int
+scm_validate_formals(ScmObj formals)
+{
+ ScmObj var;
+ int len;
+ DECLARE_INTERNAL_FUNCTION("scm_validate_formals");
+
+ /* This loop goes infinite if the formals is circular. SigSchme expects
+ * that user codes are sane here. */
+ for (len = 0; var = POP_ARG(formals), VALIDP(var); len++) {
+ if (!SYMBOLP(var))
+ return SCM_LISTLEN_ENCODE_ERROR(len);
+ }
+ if (NULLP(formals))
+ return len;
+ /* dotted list allowed */
+ if (SYMBOLP(formals))
+ return SCM_LISTLEN_ENCODE_DOTTED(len + 1);
+ return SCM_LISTLEN_ENCODE_ERROR(len);
+}
+
+int
+scm_validate_actuals(ScmObj actuals)
+{
+ int len;
+
+ len = scm_length(actuals);
+ if (SCM_LISTLEN_DOTTEDP(len))
+ len = SCM_LISTLEN_ENCODE_ERROR(len);
+ return len;
+}
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2006-01-06 17:13:27 UTC (rev 2813)
+++ branches/r5rs/sigscheme/eval.c 2006-01-06 21:42:44 UTC (rev 2814)
@@ -64,10 +64,11 @@
=======================================*/
static ScmObj reduce(ScmObj (*func)(), ScmObj args, ScmObj env,
scm_bool suppress_eval);
-static ScmObj call_closure(ScmObj proc, ScmObj args, ScmEvalState *eval_state);
+static ScmObj call_closure(ScmObj proc, ScmObj args, ScmEvalState *eval_state,
+ scm_bool suppress_eval);
static ScmObj call(ScmObj proc, ScmObj args, ScmEvalState *eval_state,
scm_bool suppress_eval);
-static ScmObj map_eval(ScmObj args, ScmObj env);
+static ScmObj map_eval(ScmObj args, int *args_len, ScmObj env);
/*=======================================
Function Implementations
@@ -168,11 +169,12 @@
return (*func)(left, right, &state);
}
-/* ARGS should already be evaluated. */
static ScmObj
-call_closure(ScmObj proc, ScmObj args, ScmEvalState *eval_state)
+call_closure(ScmObj proc, ScmObj args, ScmEvalState *eval_state,
+ scm_bool suppress_eval)
{
- ScmObj formals;
+ ScmObj formals, body, proc_env;
+ int formals_len, args_len;
DECLARE_INTERNAL_FUNCTION("call_closure");
/*
@@ -180,42 +182,57 @@
*
* (lambda <formals> <body>)
*
- * <formals> should have 3 forms.
+ * <formals> may have 3 forms.
*
* (1) <variable>
* (2) (<variable1> <variable2> ...)
* (3) (<variable1> <variable2> ... <variable n-1> . <variable n>)
*/
- formals = CAR(SCM_CLOSURE_EXP(proc));
+ formals = CAR(SCM_CLOSURE_EXP(proc));
+ body = CDR(SCM_CLOSURE_EXP(proc));
+ proc_env = SCM_CLOSURE_ENV(proc);
+ if (suppress_eval) {
+ args_len = scm_validate_actuals(args);
+ if (SCM_LISTLEN_ERRORP(args_len))
+ goto err_improper;
+ } else {
+ args = map_eval(args, &args_len, eval_state->env);
+ }
if (SYMBOLP(formals)) {
/* (1) <variable> */
eval_state->env = scm_extend_environment(LIST_1(formals),
LIST_1(args),
- SCM_CLOSURE_ENV(proc));
+ proc_env);
} else if (CONSP(formals)) {
/*
* (2) (<variable1> <variable2> ...)
* (3) (<variable1> <variable2> ... <variable n-1> . <variable n>)
*
- * - dot list is handled in lookup_frame().
+ * - dotted list is handled in env.c
*/
- eval_state->env = scm_extend_environment(formals,
- args,
- SCM_CLOSURE_ENV(proc));
+ formals_len = scm_length(formals); /* can skip full validation */
+ if (!scm_valid_environment_extension_lengthp(formals_len, args_len))
+ goto err_improper;
+
+ eval_state->env = scm_extend_environment(formals, args, proc_env);
} else if (NULLP(formals)) {
/*
* (2') <variable> is '()
*/
- eval_state->env = scm_extend_environment(SCM_NULL,
- SCM_NULL,
- SCM_CLOSURE_ENV(proc));
+ if (args_len)
+ goto err_improper;
+
+ eval_state->env = scm_extend_environment(SCM_NULL, SCM_NULL, proc_env);
} else {
- ERR_OBJ("lambda: bad formals list", formals);
+ ERR_OBJ("bad formals list", formals);
}
eval_state->ret_type = SCM_RETTYPE_NEED_EVAL;
- return scm_s_begin(CDR(SCM_CLOSURE_EXP(proc)), eval_state);
+ return scm_s_begin(body, eval_state);
+
+ err_improper:
+ ERR_OBJ("unmatched number or improper args", args);
}
/**
@@ -236,7 +253,7 @@
ScmObj (*func)();
enum ScmFuncTypeCode type;
scm_bool syntaxp;
- int mand_count, i;
+ int mand_count, i, variadic_len;
/* The +2 is for rest and env/eval_state. */
void *argbuf[SCM_FUNCTYPE_MAND_MAX + 2];
DECLARE_INTERNAL_FUNCTION("(function call)");
@@ -247,10 +264,8 @@
proc = EVAL(proc, env);
if (!FUNCP(proc)) {
- if (CLOSUREP(proc)) {
- args = (suppress_eval) ? args : map_eval(args, env);
- return call_closure(proc, args, eval_state);
- }
+ if (CLOSUREP(proc))
+ return call_closure(proc, args, eval_state, suppress_eval);
if (CONTINUATIONP(proc)) {
if (!LIST_1_P(args))
ERR("continuation takes exactly one argument");
@@ -293,7 +308,7 @@
if (type & SCM_FUNCTYPE_VARIADIC) {
if (!suppress_eval)
- args = map_eval(args, env);
+ args = map_eval(args, &variadic_len, env);
#if 0
/* Since this check is expensive, each syntax should do. Other
* procedures are already ensured that having proper args here. */
@@ -355,7 +370,7 @@
{
DECLARE_FUNCTION("eval", procedure_fixed_2);
- ENSURE_ENV(env);
+ ENSURE_VALID_ENV(env);
return scm_eval(obj, env);
}
@@ -426,19 +441,22 @@
}
static ScmObj
-map_eval(ScmObj args, ScmObj env)
+map_eval(ScmObj args, int *args_len, ScmObj env)
{
ScmQueue q;
ScmObj res, elm, rest;
+ int len;
DECLARE_INTERNAL_FUNCTION("(function call)");
- if (NULLP(args))
+ if (NULLP(args)) {
+ *args_len = 0;
return SCM_NULL;
+ }
res = SCM_NULL;
SCM_QUEUE_POINT_TO(q, res);
/* does not use POP_ARG() to increace performance */
- for (rest = args; CONSP(rest); rest = CDR(rest)) {
+ for (len = 0, rest = args; CONSP(rest); len++, rest = CDR(rest)) {
elm = EVAL(CAR(rest), env);
#if SCM_STRICT_ARGCHECK
if (VALUEPACKETP(elm))
@@ -449,6 +467,7 @@
if (!NULLP(rest))
ERR(SCM_ERRMSG_IMPROPER_ARGS, args);
+ *args_len = len;
return res;
}
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2006-01-06 17:13:27 UTC (rev 2813)
+++ branches/r5rs/sigscheme/sigscheme.h 2006-01-06 21:42:44 UTC (rev 2814)
@@ -122,6 +122,8 @@
#define SCM_ENSURE_ALLOCATED(p) \
((p) || (scm_fatal_error(SCM_ERRMSG_MEMORY_EXHAUSTED), 1))
+#define SCM_VALID_ENVP(obj) (scm_valid_environmentp(env))
+
#define SCM_ERROBJP(obj) (NFALSEP(scm_p_error_objectp(obj)))
#define SCM_SYMBOL_BOUNDP(sym) (!SCM_EQ(SCM_SYMBOL_VCELL(sym), SCM_UNBOUND))
@@ -160,6 +162,7 @@
/* result decoders for scm_length() */
#define SCM_LISTLEN_PROPERP(len) (0 <= (len))
#define SCM_LISTLEN_CIRCULARP(len) ((len) == INT_MIN)
+#define SCM_LISTLEN_ERRORP SCM_LISTLEN_CIRCULARP
#define SCM_LISTLEN_DOTTEDP(len) ((len) < 0 \
&& !SCM_LISTLEN_CIRCULARP(len))
#define SCM_LISTLEN_DOTTED(len) (abs(len))
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2006-01-06 17:13:27 UTC (rev 2813)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2006-01-06 21:42:44 UTC (rev 2814)
@@ -212,6 +212,7 @@
#define C_POINTERP SCM_C_POINTERP
#define C_FUNCPOINTERP SCM_C_FUNCPOINTERP
#define ENVP SCM_ENVP
+#define VALID_ENVP SCM_VALID_ENVP
#define ERROBJP SCM_ERROBJP
#define LISTP SCM_LISTP
@@ -323,6 +324,8 @@
#define ENSURE_CONTINUATION(obj) ENSURE_TYPE(CONTINUATIONP, "continuation", (obj))
#define ENSURE_PROCEDURE(obj) ENSURE_TYPE(PROCEDUREP, "procedure", (obj))
#define ENSURE_ENV(obj) ENSURE_TYPE(ENVP, "environment specifier", (obj))
+#define ENSURE_VALID_ENV(obj) \
+ ENSURE_TYPE(VALID_ENVP, "valid environment specifier", (obj))
#define ENSURE_ERROBJ(obj) ENSURE_TYPE(ERROBJP, "error object", (obj))
#define ENSURE_LIST(obj) ENSURE_TYPE(LISTP, "list", (obj))
@@ -353,6 +356,7 @@
/* result encoders for scm_length() */
#define SCM_LISTLEN_ENCODE_DOTTED(len) (-(len))
#define SCM_LISTLEN_ENCODE_CIRCULAR(len) (INT_MIN)
+#define SCM_LISTLEN_ENCODE_ERROR SCM_LISTLEN_ENCODE_CIRCULAR
/*=======================================
List Constructor
@@ -480,6 +484,13 @@
ScmObj scm_add_environment(ScmObj var, ScmObj val, ScmObj env);
ScmRef scm_lookup_environment(ScmObj var, ScmObj env);
+scm_bool scm_valid_environmentp(ScmObj env);
+scm_bool scm_valid_environment_extensionp(ScmObj formals, ScmObj actuals);
+scm_bool scm_valid_environment_extension_lengthp(int formals_len,
+ int actuals_len);
+int scm_validate_formals(ScmObj formals);
+int scm_validate_actuals(ScmObj actuals);
+
/* eval.c */
ScmObj scm_symbol_value(ScmObj var, ScmObj env);
ScmObj scm_tailcall(ScmObj proc, ScmObj args, ScmEvalState *eval_state);
Modified: branches/r5rs/sigscheme/syntax.c
===================================================================
--- branches/r5rs/sigscheme/syntax.c 2006-01-06 17:13:27 UTC (rev 2813)
+++ branches/r5rs/sigscheme/syntax.c 2006-01-06 21:42:44 UTC (rev 2814)
@@ -361,7 +361,7 @@
{
DECLARE_FUNCTION("lambda", syntax_variadic_1);
- if (!LISTP(formals) && !SYMBOLP(formals))
+ if (SCM_LISTLEN_ERRORP(scm_validate_formals(formals)))
ERR_OBJ("bad formals", formals);
if (!CONSP(body))
ERR_OBJ("at least one expression required", body);
Modified: branches/r5rs/sigscheme/test/test-eval.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-eval.scm 2006-01-06 17:13:27 UTC (rev 2813)
+++ branches/r5rs/sigscheme/test/test-eval.scm 2006-01-06 21:42:44 UTC (rev 2814)
@@ -32,6 +32,8 @@
(load "./test/unittest.scm")
+(define tn test-name)
+
;; check eval
(assert-equal? "eval #1" 3 (eval '(+ 1 2)
(interaction-environment)))
@@ -49,4 +51,73 @@
(assert-error "eval #6" (lambda ()
(eval '(+ 1 2) #\a)))
+(if (provided? "sigscheme")
+ (begin
+ (tn "eval with hand-maid env")
+ ;; single frame
+ (assert-equal? (tn) 10 (eval '(+ x y)
+ '(((x y) . (4 6)))))
+ ;; 2 frames
+ (assert-equal? (tn) 15 (eval '(+ x y z)
+ '(((x y) . (4 6))
+ ((z) . (5)))))
+ ;; 3 frames
+ (assert-equal? (tn) 14 (eval '(+ x y z v w)
+ '(((x y) . (4 6))
+ ((v w) . (0 -1))
+ ((z) . (5)))))
+ ;; dotted arg as formals
+ (assert-equal? (tn) 44 (eval '(apply + lst)
+ '(((x y . lst) . (4 6 8 10 12 14))
+ ((z) . (5)))))
+ ;; symbol as formals
+ (assert-equal? (tn) 54 (eval '(apply + lst)
+ '((lst . (4 6 8 10 12 14))
+ ((z) . (5)))))
+
+ (tn "eval with invalid hand-maid env")
+ ;; improper frame list
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '(((x y) . (4 6))
+ . #t))))
+ ;; actuals shortage
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '(((x y z) . (4 6))))))
+ ;; actuals shortage #2
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '(((x y . z) . (4))))))
+ ;; superfluous actuals
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '(((x y) . (4 6 8))))))
+ ;; dotted actuals
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '(((x y) . (4 . 6))))))
+ ;; dotted actuals #2
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '(((x y) . (4 6 . 8))))))
+ ;; dotted actuals #3
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '(((x . y) . (4 6 . 8))))))
+ ;; not a symbol in formals
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '(((x 3) . (4 6))))))
+ ;; not a list as actuals
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '(((x) . 4)
+ ((y) . 6)))))
+ ;; not a list as both formals and actuals
+ (assert-error (tn) (lambda ()
+ (eval '(+ 1 2)
+ '((x . 4)
+ (y . 6)))))))
+
(total-report)
Modified: branches/r5rs/sigscheme/test/test-syntax.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-syntax.scm 2006-01-06 17:13:27 UTC (rev 2813)
+++ branches/r5rs/sigscheme/test/test-syntax.scm 2006-01-06 21:42:44 UTC (rev 2814)
@@ -247,7 +247,6 @@
(tn "syntax application fixed_0")
(define s (lambda () #t)) ;; FIXME: no syntax with syntax_fixed_0
(assert-equal? (tn) #t (s))
-(assert-error (tn) (lambda () (s)))
(assert-error (tn) (lambda () (s . #t)))
(assert-error (tn) (lambda () (s #t)))
(assert-error (tn) (lambda () (s #t . #t)))
More information about the uim-commit
mailing list