Skip to content

Commit

Permalink
fix library-exports when visited but not imported
Browse files Browse the repository at this point in the history
  • Loading branch information
owaddell-beckman committed Oct 24, 2023
1 parent 149ff6d commit 76f8472
Show file tree
Hide file tree
Showing 3 changed files with 77 additions and 5 deletions.
50 changes: 50 additions & 0 deletions mats/8.ms
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 6 additions & 0 deletions release_notes/release_notes.stex
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
26 changes: 21 additions & 5 deletions s/syntax.ss
Original file line number Diff line number Diff line change
Expand Up @@ -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 '()
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)])
Expand Down

0 comments on commit 76f8472

Please sign in to comment.