diff --git a/mats/8.ms b/mats/8.ms index 0237e7e11..fdebe1c57 100644 --- 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 index 1416990d6..6324f6541 100644 --- 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 index 84051f1c5..b252fba40 100644 --- 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)])