Add tests for private exports.

diff --git a/tests/runtime/test-library-data/private-exports-example.scm b/tests/runtime/test-library-data/private-exports-example.scm
new file mode 100644 (file)
index 0000000..c83a3b6
--- /dev/null
+++ b/tests/runtime/test-library-data/private-exports-example.scm
@@ -0,0 +1,106 @@
+(define-library* (test amap)
+  (import (scheme base))
+  (export alist->amap
+          amap->alist
+         amap-args
+          amap-clean!
+          amap-clear!
+         amap-comparator
+          amap-contains?
+          amap-copy
+          amap-count
+          amap-delete!
+          amap-difference!
+          amap-empty-copy
+          amap-empty?
+          amap-entries
+          amap-find
+          amap-fold
+          amap-for-each
+         amap-implementation-name
+          amap-intern!
+          amap-intersection!
+          amap-keys
+          amap-map
+          amap-map!
+          amap-map->list
+          amap-mutable?
+          amap-pop!
+          amap-prune!
+          amap-ref
+          amap-ref/default
+          amap-set!
+          amap-size
+          amap-unfold
+          amap-union!
+          amap-update!
+          amap-update!/default
+          amap-values
+          amap-xor!
+          amap=?
+          amap?
+          make-amap)
+  (begin
+    (define alist->amap)
+    (define amap->alist)
+    (define amap-args)
+    (define amap-clean!)
+    (define amap-clear!)
+    (define amap-comparator)
+    (define amap-contains?)
+    (define amap-copy)
+    (define amap-count)
+    (define amap-delete!)
+    (define amap-difference!)
+    (define amap-empty-copy)
+    (define amap-empty?)
+    (define amap-entries)
+    (define amap-find)
+    (define amap-fold)
+    (define amap-for-each)
+    (define amap-implementation-name)
+    (define amap-intern!)
+    (define amap-intersection!)
+    (define amap-keys)
+    (define amap-map)
+    (define amap-map!)
+    (define amap-map->list)
+    (define amap-mutable?)
+    (define amap-pop!)
+    (define amap-prune!)
+    (define amap-ref)
+    (define amap-ref/default)
+    (define amap-set!)
+    (define amap-size)
+    (define amap-unfold)
+    (define amap-union!)
+    (define amap-update!)
+    (define amap-update!/default)
+    (define amap-values)
+    (define amap-xor!)
+    (define amap=?)
+    (define amap?)
+    (define make-amap)))
+
+(define-library* (test amap impl)
+  (import (scheme base))
+  (export all-amap-args
+         amap-implementation-names
+         amap-implementation-supported-args
+         amap-implementation-supports-args?
+         amap-implementation-supports-comparator?
+          define-amap-implementation
+          define-amap-implementation-selector
+         make-amap-implementation)
+  (export-to (test amap)
+             select-impl)
+  (begin
+    (define all-amap-args)
+    (define amap-implementation-names)
+    (define amap-implementation-supported-args)
+    (define amap-implementation-supports-args?)
+    (define amap-implementation-supports-comparator?)
+    (define define-amap-implementation)
+    (define define-amap-implementation-selector)
+    (define make-amap-implementation)
+    (define select-impl)))
\ No newline at end of file

diff --git a/tests/runtime/test-library-data/support-code.scm b/tests/runtime/test-library-data/support-code.scm
index 47ae6605df39d4a403ca6231e3af8ea6f3d30e79..cf522a136c0e2eb1900442a06b965235ab37a965 100644 (file)
--- a/tests/runtime/test-library-data/support-code.scm
+++ b/tests/runtime/test-library-data/support-code.scm
@@ -39,6 +39,11 @@ USA.
       (make-library-ixport library export)
       (make-library-ixport library (cadr export) (caddr export))))
 
+(define (convert-exports library exports)
+  (map (lambda (name)
+        (convert-export library name))
+       exports))
+
 (define (convert-content content)
   (case (car content)
     ((include include-ci)
@@ -118,6 +123,11 @@ USA.
    (merge-pathnames "test-library-data/srfi-140-example.scm"
                    test-directory)))
 
+(define private-exports-example-filename
+  (->namestring
+   (merge-pathnames "test-library-data/private-exports-example.scm"
+                   test-directory)))
+
 (define (exports-of name db)
   (library-exports (registered-library name db)))
 

diff --git a/tests/runtime/test-library-ixports.scm b/tests/runtime/test-library-ixports.scm
index 26ca65602754f81116297dc0d85ff15050bf2db2..3b5492b9af7a68db5eaf54c02a6ad141f718e0d3 100644 (file)
--- a/tests/runtime/test-library-ixports.scm
+++ b/tests/runtime/test-library-ixports.scm
@@ -65,9 +65,7 @@ USA.
                                               'create-foo-quux)))
       (assert-lset= library-ixport=?
                    (library-exports library)
-                   (map (lambda (export)
-                          (convert-export (library-name library) export))
-                        ex1-exports)))))
+                   (convert-exports (library-name library) ex1-exports)))))
 
 (define-test 'mit-libraries:srfi-140
   (lambda ()
@@ -159,4 +157,79 @@ USA.
     (utf16le->string utf16le->mstring)
     (utf8->string utf8->mstring)
     (vector->string vector->mstring)
-    (xsubstring xmsubstring)))
\ No newline at end of file
+    (xsubstring xmsubstring)))
+
+(define-test 'test-private-exports
+  (lambda ()
+    (let ((source (read-r7rs-source private-exports-example-filename))
+         (db (copy-library-db host-library-db)))
+      (register-r7rs-source! source db)
+      (let ((amap-base (registered-library '(test amap) db))
+           (amap-impl (registered-library '(test amap impl) db)))
+       (assert-lset= library-ixport=?
+                     (library-exports amap-base)
+                     (convert-exports '(test amap)
+                                      expected-amap-base-exports))
+       (assert-lset= library-ixport=?
+                     (library-exports amap-impl)
+                     (convert-exports '(test amap impl)
+                                      expected-amap-impl-exports))
+       (assert-lset= library-ixport=?
+                     (library-exports amap-impl amap-base)
+                     (convert-exports '(test amap impl)
+                                      expected-amap-impl-exports-private))))))
+
+(define expected-amap-base-exports
+  '(alist->amap
+    amap->alist
+    amap-args
+    amap-clean!
+    amap-clear!
+    amap-comparator
+    amap-contains?
+    amap-copy
+    amap-count
+    amap-delete!
+    amap-difference!
+    amap-empty-copy
+    amap-empty?
+    amap-entries
+    amap-find
+    amap-fold
+    amap-for-each
+    amap-implementation-name
+    amap-intern!
+    amap-intersection!
+    amap-keys
+    amap-map
+    amap-map!
+    amap-map->list
+    amap-mutable?
+    amap-pop!
+    amap-prune!
+    amap-ref
+    amap-ref/default
+    amap-set!
+    amap-size
+    amap-unfold
+    amap-union!
+    amap-update!
+    amap-update!/default
+    amap-values
+    amap-xor!
+    amap=?
+    amap?
+    make-amap))
+
+(define expected-amap-impl-exports
+  '(all-amap-args
+    amap-implementation-names
+    amap-implementation-supported-args
+    amap-implementation-supports-args?
+    amap-implementation-supports-comparator?
+    define-amap-implementation
+    define-amap-implementation-selector
+    make-amap-implementation))
+
+(define expected-amap-impl-exports-private
+  (cons 'select-impl expected-amap-impl-exports))
\ No newline at end of file

diff --git a/tests/runtime/test-library-parser.scm b/tests/runtime/test-library-parser.scm
index fd932820f0c2b87a3aeb3aa4acb7f56755a68e0f..6648e796382e9dfcf0179d513a658a64c3b26233 100644 (file)
--- a/tests/runtime/test-library-parser.scm
+++ b/tests/runtime/test-library-parser.scm
@@ -114,4 +114,15 @@ USA.
                          (grid-set! grid 3 2 #t)
                          (life grid 80))))
        (assert-string= (library-filename program)
-                       r7rs-example-filename)))))
\ No newline at end of file
+                       r7rs-example-filename)))))
+
+(define-test 'read-r7rs-source:privte-exports
+  (lambda ()
+    (let ((source (read-r7rs-source private-exports-example-filename)))
+      (let ((libraries (r7rs-source-libraries source)))
+       (assert-true (list? libraries))
+       (assert-= (length libraries) 2)
+       (assert-equal (map library-name libraries)
+                     '((test amap)
+                       (test amap impl))))
+      (assert-false (r7rs-source-program source)))))
\ No newline at end of file