Tweak bundle index lookup; fix bundle tests.

diff --git a/src/runtime/bundle.scm b/src/runtime/bundle.scm
index 5cd06e346107401ece49058d7789103b3df78af5..0fc2cdb337f97593210c84e43c0473509baf96ca 100644 (file)
--- a/src/runtime/bundle.scm
+++ b/src/runtime/bundle.scm
@@ -109,14 +109,7 @@ USA.
                     (element-index tag name #t)))))
 
 (define (element-index tag name required?)
-  (let ((index
-        (let* ((v (tag-element-names tag))
-               (end (vector-length v)))
-          (let loop ((i 0))
-            (and (fix:< i end)
-                 (if (eq? name (vector-ref v i))
-                     i
-                     (loop (fix:+ i 1))))))))
+  (let ((index (vector-find-next-element (tag-element-names tag) name)))
     (if (not (or index (not required?)))
        (error "Unknown element name:" name (dispatch-tag->predicate tag)))
     index))

diff --git a/tests/runtime/test-bundle.scm b/tests/runtime/test-bundle.scm
index a13e81872503db7f3bf73405715058d15c20bed9..ae265d5600b5e2d021f56b4e14cc56549b8b0263 100644 (file)
--- a/tests/runtime/test-bundle.scm
+++ b/tests/runtime/test-bundle.scm
@@ -30,35 +30,48 @@ USA.
 \f
 (define-test 'simple
   (lambda ()
-    (define-bundle-interface <foo> capture-foo foo? a b c)
+    (define-bundle-interface foo? make-foo capture-foo a b c)
 
-    (assert-true (bundle-interface? <foo>))
-    (assert-equal (bundle-interface-element-names <foo>)
+    (assert-true (bundle-interface? foo?))
+    (assert-equal (bundle-interface-element-names foo?)
                  '(a b c))
     (for-each (lambda (name)
-               (assert-equal (bundle-interface-element-properties <foo> name)
+               (assert-equal (bundle-interface-element-properties foo? name)
                              '()))
-             (bundle-interface-element-names <foo>))
-
-    (define foo
-      (let ((a 0)
-           (b 1)
-           (c 3))
-       (capture-foo)))
-
-    (assert-true (foo? foo))
-    (assert-eqv (bundle-ref foo 'a) 0)
-    (assert-eqv (bundle-ref foo 'b) 1)
-    (assert-eqv (bundle-ref foo 'c) 3)
-    (assert-eqv (bundle-ref foo 'd #f) #f)
-    (assert-error (lambda () (bundle-ref foo 'd)))))
+             (bundle-interface-element-names foo?))
+
+    (define bundle-a (bundle-accessor foo? 'a))
+    (define bundle-b (bundle-accessor foo? 'b))
+    (define bundle-c (bundle-accessor foo? 'c))
+    (assert-error (lambda () (bundle-accessor foo 'd)))
+
+    (define (test-bundle bundle av bv cv)
+      (assert-true (foo? bundle))
+      (assert-eqv (bundle-ref bundle 'a) av)
+      (assert-eqv (bundle-ref bundle 'b) bv)
+      (assert-eqv (bundle-ref bundle 'c) cv)
+      (assert-eqv (bundle-ref bundle 'd #f) #f)
+      (assert-error (lambda () (bundle-ref foo 'd)))
+      (assert-eqv (bundle-a bundle) av)
+      (assert-eqv (bundle-b bundle) bv)
+      (assert-eqv (bundle-c bundle) cv))
+
+    (let ((a 10)
+         (b 20)
+         (c 40))
+      (test-bundle (make-foo a b c) a b c))
+
+    (let ((a 0)
+         (b 1)
+         (c 3))
+      (test-bundle (capture-foo) a b c))))
 
 (define-test 'metadata-table
   (lambda ()
 
-    (define-bundle-interface <metadata-table>
+    (define-bundle-interface metadata-table?
+      make-metadata-table
       capture-metadata-table
-      metadata-table?
       has?
       get
       put!