fix library-exports when visited but not imported

cisco · Nov 8, 2023 · 352f7f5 · 352f7f5
1 parent 5c27e27
commit 352f7f5
Show file tree

Hide file tree

Showing 3 changed files with 77 additions and 5 deletions.
diff --git a/mats/8.ms b/mats/8.ms
@@ -11287,6 +11287,56 @@
       (load-library "testfile-li3.so")
       (library-object-filename '(testfile-li3)))
     "testfile-li3.so")
+  (begin
+    (define (test-library-info do-load file)
+      (separate-eval
+       `(,do-load ,file)
+       ;; no import here
+       '(begin
+          (define (show f)
+            (printf "~s: " f)
+            (guard (e [else (display-condition e) (newline)])
+              (printf "~s\n" ((eval f) '(testfile-li3)))))
+          (show 'library-object-filename)
+          (show 'library-requirements)
+          (show 'library-version)
+          (show 'library-exports))
+       ;; now import
+       '(import (testfile-li3))
+       '(show 'library-exports)))
+    #t)
+  (equal?
+   (test-library-info 'load-library "testfile-li3.ss")
+   (string-append
+    "library-object-filename: #f\n"
+    "library-requirements: ((rnrs (6)))\n"
+    "library-version: ()\n"
+    "library-exports: (x)\n"
+    "library-exports: (x)\n"))
+  (equal?
+   (test-library-info 'load-library "testfile-li3.so")
+   (string-append
+    "library-object-filename: \"testfile-li3.so\"\n"
+    "library-requirements: ((rnrs (6)))\n"
+    "library-version: ()\n"
+    "library-exports: (x)\n"
+    "library-exports: (x)\n"))
+  (equal?
+   (test-library-info 'visit "testfile-li3.so")
+   (string-append
+    "library-object-filename: \"testfile-li3.so\"\n"
+    "library-requirements: Exception: run-time information for library (testfile-li3) has not been loaded\n"
+    "library-version: ()\n"
+    "library-exports: (x)\n"
+    "library-exports: (x)\n"))
+  (equal?
+   (test-library-info 'revisit "testfile-li3.so")
+   (string-append
+    "library-object-filename: \"testfile-li3.so\"\n"
+    "library-requirements: Exception: compile-time information for library (testfile-li3) has not been loaded\n"
+    "library-version: ()\n"
+    "library-exports: Exception: compile-time information for library (testfile-li3) has not been loaded\n"
+    "library-exports: (x)\n"))
 )
 
 (mat rnrs-eval

diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex
@@ -2701,6 +2701,12 @@ in fasl files does not generally make sense.
 %-----------------------------------------------------------------------------
 \section{Bug Fixes}\label{section:bugfixes}
 
+\subsection{\scheme{library-exports} for library that is not yet imported (9.9.9)}
+
+When visiting or loading a separately compiled library,
+\scheme{library-exports} raised an exception if the library was not
+yet imported.
+
 \subsection{Incorrect code for \scheme{record?} at optimize-level 3 (9.9.9)}
 
 At optimize-level 3, the \scheme{record?} predicate could short circuit without

diff --git a/s/syntax.ss b/s/syntax.ss
@@ -828,12 +828,14 @@
          ,(build-sequence no-source init*)))))
 
 (define build-top-library/ct
-  (lambda (uid export-id* import-code* visit-code*)
+  (lambda (uid export-id* interface import-code* visit-code*)
     (with-output-language (Lexpand ctLibrary)
       `(library/ct ,uid
          (,export-id* ...)
-         ,(build-lambda no-source '()
-            (build-sequence no-source import-code*))
+         ,(build-case-lambda no-source ;; case-lambda to simplify bootstrapping
+            (list
+             (list '() (build-sequence no-source import-code*))
+             (list (list (gen-var 'ignored)) (build-data no-source interface))))
          ,(if (null? visit-code*)
                 (build-primref 3 'void)
                 (build-lambda no-source '()
@@ -2727,6 +2729,8 @@
                                                       (cons label ls)
                                                       ls)))
                                      '() env*)
+                                   ; interface
+                                   (binding-value interface-binding)
                                    ; import code
                                    `(,(build-cte-install bound-id (build-data no-source interface-binding) '*system*)
                                      ,@(let ([clo* (fold-left (lambda (clo* dl db)
@@ -5364,8 +5368,20 @@
     (set-who! library-exports
       (lambda (libref)
         (let* ([binding (lookup-global (get-lib who libref))]
-               [iface (get-indirect-interface (binding-value binding))])
-          (unless (and (eq? (binding-type binding) '$module) (interface? iface))
+               [iface
+                (case (binding-type binding)
+                 [($module) (get-indirect-interface (binding-value binding))]
+                 [(global)
+                  (let ([desc (get-library-descriptor (binding-value binding))])
+                    (and desc (libdesc-visible? desc)
+                         (cond
+                          [(libdesc-import-code desc) =>
+                           (lambda (import-code)
+                             (guard (c [else #f])
+                               (import-code 'get-iface)))]
+                          [else #f])))]
+                 [else #f])])
+          (unless (interface? iface)
             ($oops who "unexpected binding ~s" binding))
           (let* ([exports (interface-exports iface)]
                  [n (vector-length exports)])