~ chicken-core (chicken-5) 1c5806c6f4cc08861b2746fdc28202ddca227c74

commit 1c5806c6f4cc08861b2746fdc28202ddca227c74
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Jul 9 08:08:27 2010 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Jul 9 08:08:27 2010 +0200

    added Knuth's man-or-boy test (thanks to Benedikt Rosenau)

diff --git a/distribution/manifest b/distribution/manifest
index d82681cd..40dfcb27 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -109,6 +109,7 @@ tests/srfi-4-tests.scm
 tests/srfi-18-tests.scm
 tests/hash-table-tests.scm
 tests/apply-test.scm
+tests/man-or-boy.scm
 tests/embedded1.c
 tests/embedded2.scm
 tests/fixnum-tests.scm
diff --git a/tests/man-or-boy.scm b/tests/man-or-boy.scm
new file mode 100644
index 00000000..60bb6f27
--- /dev/null
+++ b/tests/man-or-boy.scm
@@ -0,0 +1,33 @@
+;;;; man-or-boy.scm - Knuth's 
+
+
+;; begin
+;;   real procedure A (k, x1, x2, x3, x4, x5);
+;;   value k; integer k;
+;;   begin
+;;     real procedure B;
+;;     begin k:= k - 1;
+;;           B:= A := A (k, B, x1, x2, x3, x4);
+;;     end;
+;;     if k <= 0 then A:= x4 + x5 else B;
+;;   end;
+;;   outreal (A (10, 1, -1, -1, 1, 0));
+;; end;
+
+
+(define (A k x1 x2 x3 x4 x5)
+  (define (B)
+    (set! k (- k 1))
+    (A k B x1 x2 x3 x4))
+  (if (<= k 0)
+      (+ (x4) (x5))
+      (B)))
+ 
+(assert
+ (= -175416
+    (A 20
+       (lambda () 1) 
+       (lambda () -1)
+       (lambda () -1)
+       (lambda () 1)
+       (lambda () 0))))
diff --git a/tests/runbench.sh b/tests/runbench.sh
index c4927146..05125ac8 100644
--- a/tests/runbench.sh
+++ b/tests/runbench.sh
@@ -26,7 +26,7 @@ esac
 
 run()
 {
-    /usr/bin/time "$timeopts" ./a.out
+    /usr/bin/time "$timeopts" ./a.out "$1"
 }
 
 echo
@@ -60,3 +60,7 @@ run
 echo -n "fft/unboxed ... "
 $compile fft.scm -D unboxed
 run
+
+echo -n "man-or-oby ... "
+$compile man-or-boy.scm
+run -:d