~ chicken-core (chicken-5) 7c4050ddad74adf02bfb522dca89206fcf8570fe
commit 7c4050ddad74adf02bfb522dca89206fcf8570fe
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Oct 31 00:21:42 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Oct 31 00:21:42 2010 +0200
added tests by Alan Post (slightly fixed)
diff --git a/distribution/manifest b/distribution/manifest
index f412752b..8111f75f 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -95,6 +95,7 @@ srfi-4.scm
stub.scm
support.scm
tcp.scm
+tests/test-optional.scm
tests/arithmetic-test.scm
tests/arithmetic-test.32.expected
tests/arithmetic-test.64.expected
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 563a7db3..61a8c61d 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -156,6 +156,11 @@ $interpret -s import-library-test2.scm
$compile import-library-test2.scm
./a.out
+echo "======================================== optionals test ..."
+$interpret -s test-optional.scm
+$compile test-optional.scm
+./a.out
+
echo "======================================== syntax tests (matchable) ..."
$interpret matchable.scm -s match-test.scm
diff --git a/tests/test-optional.scm b/tests/test-optional.scm
new file mode 100644
index 00000000..e8c80f9a
--- /dev/null
+++ b/tests/test-optional.scm
@@ -0,0 +1,128 @@
+(define (test baseline result)
+ (print baseline " = " result)
+ (assert (equal? baseline result)))
+
+;;
+;; basic optional arguments with default value.
+;;
+
+(define (foo0 #!optional a0 a1 a2 a3)
+ (list a0 a1 a2 a3))
+
+(define (foo1 a0 #!optional a1 a2 a3)
+ (list a0 a1 a2 a3))
+
+(define (foo2 a0 a1 #!optional a2 a3)
+ (list a0 a1 a2 a3))
+
+(define (foo3 a0 a1 a2 #!optional a3)
+ (list a0 a1 a2 a3))
+
+(test '(#f #f #f #f) (foo0))
+(test '(1 #f #f #f) (foo0 1))
+(test '(1 2 #f #f) (foo0 1 2))
+(test '(1 2 3 #f) (foo0 1 2 3))
+(test '(1 2 3 4) (foo0 1 2 3 4))
+
+;(test '(#f #f #f #f) (foo1)) ; invalid, too few arguments.
+(test '(1 #f #f #f) (foo1 1))
+(test '(1 2 #f #f) (foo1 1 2))
+(test '(1 2 3 #f) (foo1 1 2 3))
+(test '(1 2 3 4) (foo1 1 2 3 4))
+
+;(test '(#f #f #f #f) (foo2)) ; invalid, too few arguments.
+;(test '(1 #f #f #f) (foo2 0)) ; invalid, too few arguments.
+(test '(1 2 #f #f) (foo2 1 2))
+(test '(1 2 #f #f) (foo2 1 2))
+(test '(1 2 3 #f) (foo2 1 2 3))
+(test '(1 2 3 4) (foo2 1 2 3 4))
+
+;(test '(#f #f #f #f) (foo3)) ; invalid, too few arguments.
+;(test '(1 #f #f #f) (foo3 1)) ; invalid, too few arguments.
+;(test '(1 2 #f #f) (foo3 1 2)) ; invalid, too few arguments.
+(test '(1 2 3 #f) (foo3 1 2 3))
+(test '(1 2 3 4) (foo3 1 2 3 4))
+
+;;
+;; basic optional arguments with manual default value.
+;;
+
+(define (foo0 #!optional (a0 -1) (a1 -2) (a2 -3) (a3 -4))
+ (list a0 a1 a2 a3))
+
+(define (foo1 a0 #!optional (a1 -2) (a2 -3) (a3 -4))
+ (list a0 a1 a2 a3))
+
+(define (foo2 a0 a1 #!optional (a2 -3) (a3 -4))
+ (list a0 a1 a2 a3))
+
+(define (foo3 a0 a1 a2 #!optional (a3 -4))
+ (list a0 a1 a2 a3))
+
+
+(test '(-1 -2 -3 -4) (foo0))
+(test '(1 -2 -3 -4) (foo0 1))
+(test '(1 2 -3 -4) (foo0 1 2))
+(test '(1 2 3 -4) (foo0 1 2 3))
+(test '(1 2 3 4) (foo0 1 2 3 4))
+
+;(test '(-1 -2 -3 -4) (foo1)) ; invalid, too few arguments.
+(test '(1 -2 -3 -4) (foo1 1))
+(test '(1 2 -3 -4) (foo1 1 2))
+(test '(1 2 3 -4) (foo1 1 2 3))
+(test '(1 2 3 4) (foo1 1 2 3 4))
+
+;(test '(-1 -2 -3 -4) (foo2)) ; invalid, too few arguments.
+;(test '(1 -2 -3 -4) (foo2 0)) ; invalid, too few arguments.
+(test '(1 2 -3 -4) (foo2 1 2))
+(test '(1 2 -3 -4) (foo2 1 2))
+(test '(1 2 3 -4) (foo2 1 2 3))
+(test '(1 2 3 4) (foo2 1 2 3 4))
+
+;(test '(-1 -2 -3 -4) (foo3)) ; invalid, too few arguments.
+;(test '(1 -2 -3 -4) (foo3 1)) ; invalid, too few arguments.
+;(test '(1 2 -3 -4) (foo3 1 2)) ; invalid, too few arguments.
+(test '(1 2 3 -4) (foo3 1 2 3))
+(test '(1 2 3 4) (foo3 1 2 3 4))
+
+;;
+;; optional arguments with default value set from previous default.
+;;
+;; NOTE: these currently fail.
+
+(define (foo0 #!optional (a0 -1) (a1 (- a0 1)) (a2 (- a1 1)) (a3 (- a2 1)))
+ (list a0 a1 a2 a3))
+
+(define (foo1 a0 #!optional (a1 -2) (a2 (- a1 1)) (a3 (- a2 1)))
+ (list a0 a1 a2 a3))
+
+(define (foo2 a0 a1 #!optional (a2 -3) (a3 (- a2 1)))
+ (list a0 a1 a2 a3))
+
+(define (foo3 a0 a1 a2 #!optional (a3 -4))
+ (list a0 a1 a2 a3))
+
+
+(test '(-1 -2 -3 -4) (foo0))
+(test '(1 0 -1 -2) (foo0 1))
+(test '(1 2 1 0) (foo0 1 2))
+(test '(1 2 3 2) (foo0 1 2 3))
+(test '(1 2 3 4) (foo0 1 2 3 4))
+
+;(test '(-1 -2 -3 -4) (foo1)) ; invalid, too few arguments.
+(test '(1 -2 -3 -4) (foo1 1))
+(test '(1 2 1 0) (foo1 1 2))
+(test '(1 2 3 2) (foo1 1 2 3))
+(test '(1 2 3 4) (foo1 1 2 3 4))
+
+;(test '(-1 -2 -3 -4) (foo2)) ; invalid, too few arguments.
+;(test '(1 -2 -3 -4) (foo2 0)) ; invalid, too few arguments.
+(test '(1 2 -3 -4) (foo2 1 2))
+(test '(1 2 3 2) (foo2 1 2 3))
+(test '(1 2 3 4) (foo2 1 2 3 4))
+
+;(test '(-1 -2 -3 -4) (foo3)) ; invalid, too few arguments.
+;(test '(1 -2 -3 -4) (foo3 1)) ; invalid, too few arguments.
+;(test '(1 2 -3 -4) (foo3 1 2)) ; invalid, too few arguments.
+(test '(1 2 3 -4) (foo3 1 2 3))
+(test '(1 2 3 4) (foo3 1 2 3 4))
Trap