Author: yamakenz
Date: Tue May 29 07:27:15 2007
New Revision: 4572
Modified:
sigscheme-trunk/QALog
sigscheme-trunk/src/module-srfi8.c
sigscheme-trunk/test/test-srfi8.scm
Log:
* src/module-srfi8.c
- (scm_s_srfi8_receive): Modify an error message
* test/test-srfi8.scm
- Add various tests
- Remove obsolete and incomplete tests
- Fix number of values for "receive invalid formals: X as an arg" tests
* QALog
- Update
Modified: sigscheme-trunk/QALog
==============================================================================
--- sigscheme-trunk/QALog (original)
+++ sigscheme-trunk/QALog Tue May 29 07:27:15 2007
@@ -268,7 +268,7 @@
srfi module-srfi1.c
srfi module-srfi2.c
yyyy yyy srfi module-srfi6.c
- srfi module-srfi8.c
+yyyy yyy srfi module-srfi8.c
yyyy yy srfi module-srfi23.c
yyyy yyy srfi module-srfi28.c
yyyy yyy srfi module-srfi34.c
@@ -948,14 +948,14 @@
file: module-srfi8.c
category: srfi
-spec by eyes:
-spec by tests:
-general review:
-64-bit by eyes:
-64-bit by tests:
-coding style:
-normal case tests:
-corner case tests:
+spec by eyes: [EMAIL PROTECTED]
+spec by tests: [EMAIL PROTECTED]
+general review: [EMAIL PROTECTED]
+64-bit by eyes: [EMAIL PROTECTED]
+64-bit by tests:
+coding style: [EMAIL PROTECTED]
+normal case tests: [EMAIL PROTECTED]
+corner case tests: [EMAIL PROTECTED]
file: module-srfi23.c
category: srfi
@@ -1081,6 +1081,10 @@
Log
---
+2007-05-29 YamaKen <yamaken AT bp.iij4u.or.jp>
+ * module-srfi8.c
+ - QA done @r4572 with test-srfi8.scm
+
2007-05-25 YamaKen <yamaken AT bp.iij4u.or.jp>
* vector.c
- QA done @r4562 with test-vector.scm
Modified: sigscheme-trunk/src/module-srfi8.c
==============================================================================
--- sigscheme-trunk/src/module-srfi8.c (original)
+++ sigscheme-trunk/src/module-srfi8.c Tue May 29 07:27:15 2007
@@ -105,7 +105,7 @@
}
if (!scm_valid_environment_extension_lengthp(formals_len, actuals_len))
- ERR_OBJ("unmatched number of args for multiple values", actuals);
+ ERR_OBJ("unmatched number of values for the formals", actuals);
eval_state->env = env = scm_extend_environment(formals, actuals, env);
return scm_s_body(body, eval_state);
Modified: sigscheme-trunk/test/test-srfi8.scm
==============================================================================
--- sigscheme-trunk/test/test-srfi8.scm (original)
+++ sigscheme-trunk/test/test-srfi8.scm Tue May 29 07:27:15 2007
@@ -40,38 +40,39 @@
(define tn test-name)
-(receive (a b c)
- (values #f #t '())
- (assert-equal? "receive test 1" #f a)
- (assert-equal? "receive test 2" #t b)
- (assert-equal? "receive test 3" '() c))
-
-(assert-equal? "receive test4"
- 5
- (receive (a b) (values 4 5)
- b))
-
-(assert-true "receive test5"
- (receive args (values)
- (null? args)))
-
-(assert-true "receive test6"
- (receive () (values)
- #t))
-
-(define var 'global)
-(receive (a b c var)
- (values 'a 6 var 'local)
- (assert-equal? "receive test 7" 'a a)
- (assert-equal? "receive test 8" 6 b)
- (assert-equal? "receive test 9" 'global c)
- (assert-equal? "receive test 10" 'local var))
+(tn "receive varlist formals fixed_0")
+(assert-equal? (tn) '() (receive () (values) '()))
+(assert-error (tn) (lambda () (receive () 0 '())))
+(assert-error (tn) (lambda () (receive () (values 0) '())))
+(assert-error (tn) (lambda () (receive () (values 0 1) '())))
+(assert-error (tn) (lambda () (receive () (values 0 1 2) '())))
+
+(tn "receive varlist formals fixed_1")
+(assert-error (tn) (lambda () (receive (x) (values) (list x))))
+(assert-equal? (tn) '(0) (receive (x) 0 (list x)))
+(assert-equal? (tn) '(0) (receive (x) (values 0) (list x)))
+(assert-error (tn) (lambda () (receive (x) (values 0 1) (list x))))
+(assert-error (tn) (lambda () (receive (x) (values 0 1 2) (list x))))
+
+(tn "receive varlist formals fixed_2")
+(assert-error (tn) (lambda () (receive (x y) (values) (list x y))))
+(assert-error (tn) (lambda () (receive (x y) 0 (list x y))))
+(assert-error (tn) (lambda () (receive (x y) (values 0) (list x y))))
+(assert-equal? (tn) '(0 1) (receive (x y) (values 0 1) (list x y)))
+(assert-error (tn) (lambda () (receive (x y) (values 0 1 2) (list x y))))
+
+(tn "receive varlist formals fixed_3")
+(assert-error (tn) (lambda () (receive (x y z) (values) (list x y z))))
+(assert-error (tn) (lambda () (receive (x y z) 0 (list x y z))))
+(assert-error (tn) (lambda () (receive (x y z) (values 0) (list x y z))))
+(assert-error (tn) (lambda () (receive (x y z) (values 0 1) (list x y z))))
+(assert-equal? (tn) '(0 1 2) (receive (x y z) (values 0 1 2) (list x y z)))
+(assert-error (tn) (lambda () (receive (x y z) (values 0 1 2 3) (list x y
z))))
(tn "receive symbol formals (variadic_0)")
(assert-equal? (tn) '() (receive args (values) args))
(assert-equal? (tn) '(0) (receive args 0 args))
(assert-equal? (tn) '(0) (receive args (values 0) args))
-(assert-equal? (tn) '(0) (receive args (values 0) args))
(assert-equal? (tn) '(0 1) (receive args (values 0 1) args))
(assert-equal? (tn) '(0 1 2) (receive args (values 0 1 2) args))
@@ -79,7 +80,6 @@
(assert-error (tn) (lambda () (receive (x . rest) (values) (list x rest))))
(assert-equal? (tn) '(0 ()) (receive (x . rest) 0 (list x rest)))
(assert-equal? (tn) '(0 ()) (receive (x . rest) (values 0) (list x rest)))
-(assert-equal? (tn) '(0 ()) (receive (x . rest) (values 0) (list x rest)))
(assert-equal? (tn) '(0 (1)) (receive (x . rest) (values 0 1) (list x rest)))
(assert-equal? (tn) '(0 (1 2)) (receive (x . rest) (values 0 1 2)
(list x rest)))
@@ -91,8 +91,6 @@
(receive (x y . rest) 0 (list x y rest))))
(assert-error (tn) (lambda ()
(receive (x y . rest) (values 0) (list x y rest))))
-(assert-error (tn) (lambda ()
- (receive (x y . rest) (values 0) (list x y rest))))
(assert-equal? (tn) '(0 1 ())
(receive (x y . rest) (values 0 1) (list x y rest)))
(assert-equal? (tn) '(0 1 (2))
@@ -100,78 +98,131 @@
(assert-equal? (tn) '(0 1 (2 3))
(receive (x y . rest) (values 0 1 2 3) (list x y rest)))
-(if (and (provided? "sigscheme")
+(tn "receive env")
+(assert-equal? (tn)
+ '(7 -1 3 4 5)
+ (let ((x 3)
+ (y 4)
+ (z 5))
+ (receive (a b) (values (+ x y) (- x y))
+ (list a b x y z))))
+(assert-equal? (tn)
+ '(3 4 5)
+ (let ((x 3)
+ (y 4)
+ (z 5))
+ (receive (x y) (values x y)
+ (list x y z))))
+(assert-equal? (tn)
+ '(7 -1 5)
+ (let ((x 3)
+ (y 4)
+ (z 5))
+ (receive (x y) (values (+ x y) (- x y))
+ (list x y z))))
+
+(tn "receive sequencial <body> evaluation")
+(assert-equal? (tn)
+ '(6 15)
+ (receive (x y) (values (+ 2 3) (+ 4 5))
+ (set! x (+ x 1))
+ (set! y (+ y x))
+ (list x y)))
+
+(tn "receive eval count exactness")
+(assert-equal? (tn)
+ '(x y)
+ (let ((x 3)
+ (y 4))
+ (receive (x y) (values 'x 'y) (list x y))))
+(assert-equal? (tn)
+ '(5 9)
+ (receive (x y) (values (+ 2 3) (+ 4 5)) (list x y)))
+(assert-equal? (tn)
+ '((+ 2 3) (+ 4 5))
+ (receive (x y) (values '(+ 2 3) '(+ 4 5)) (list x y)))
+
+(tn "receive invalid forms")
+;; empty <body>
+(assert-error (tn) (lambda () (receive (x) (values 0))))
+
+(if (and 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 (#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) (values #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (#t x) (values #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 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)))
+ (assert-error (tn) (lambda () (receive (x y #t) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x y . #t) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x #t y) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x #t . y) (values #t #t #t) #t)))
(tn "receive invalid formals: intger as an arg")
+ (assert-error (tn) (lambda () (receive 1 #t #t)))
(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) (values #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (1 x) (values #t #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)))
+ (assert-error (tn) (lambda () (receive (x y 1) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x y . 1) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x 1 y) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x 1 . y) (values #t #t #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-error (tn) (lambda () (receive (x ()) (values #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (() x) (values #t #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)))
+ (assert-error (tn) (lambda () (receive (x y ()) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x y . ()) (values #t #t #t) x)))
+ (assert-error (tn) (lambda () (receive (x () y) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x () . y) (values #t #t #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)) (values #t #t) #t)))
+ (assert-error (tn) (lambda () (receive ((a) x) (values #t #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)))
+ (assert-error (tn) (lambda () (receive (x y (a)) (values #t #t #t) #t)))
+ (assert-true (tn) (lambda () (receive (x y . (a)) (values #t #t #t) x)))
+ (assert-error (tn) (lambda () (receive (x (a) y) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x (a) . y) (values #t #t #t)
#t)))
(tn "receive invalid formals: char as an arg")
+ (assert-error (tn) (lambda () (receive #\a #t #t)))
(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) (values #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (#\a x) (values #t #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)))
+ (assert-error (tn) (lambda () (receive (x y #\a) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x y . #\a) (values #t #t #t)
#t)))
+ (assert-error (tn) (lambda () (receive (x #\a y) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x #\a . y) (values #t #t #t)
#t)))
(tn "receive invalid formals: string as an arg")
+ (assert-error (tn) (lambda () (receive "a" #t #t)))
(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") (values #t #t) #t)))
+ (assert-error (tn) (lambda () (receive ("a" x) (values #t #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)))
+ (assert-error (tn) (lambda () (receive (x y "a") (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x y . "a") (values #t #t #t)
#t)))
+ (assert-error (tn) (lambda () (receive (x "a" y) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x "a" . y) (values #t #t #t)
#t)))
(tn "receive invalid formals: vector as an arg")
+ (assert-error (tn) (lambda () (receive #(a) #t #t)))
(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)) (values #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (#(a) x) (values #t #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)))))
+ (assert-error (tn) (lambda () (receive (x y #(a)) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x y . #(a)) (values #t #t #t)
#t)))
+ (assert-error (tn) (lambda () (receive (x #(a) y) (values #t #t #t) #t)))
+ (assert-error (tn) (lambda () (receive (x #(a) . y) (values #t #t #t)
#t)))))
(total-report)
