mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-02 02:10:19 +02:00
(resolve-interface): When returning a custom
interface, also consult source module's entire binding set, not just its exported bindings, before throwing error.
This commit is contained in:
parent
df1cc476e4
commit
f9da74b0f6
1 changed files with 17 additions and 16 deletions
|
@ -1713,10 +1713,11 @@
|
||||||
(seen (if direct? bspec (cdr bspec))))
|
(seen (if direct? bspec (cdr bspec))))
|
||||||
(module-add! custom-i (renamer seen)
|
(module-add! custom-i (renamer seen)
|
||||||
(or (module-local-variable public-i orig)
|
(or (module-local-variable public-i orig)
|
||||||
|
(module-local-variable module orig)
|
||||||
(error
|
(error
|
||||||
;; fixme: format manually for now
|
;; fixme: format manually for now
|
||||||
(simple-format
|
(simple-format
|
||||||
#f "no binding `~A' exported from module ~A"
|
#f "no binding `~A' in module ~A"
|
||||||
orig name))))))
|
orig name))))))
|
||||||
selection)
|
selection)
|
||||||
custom-i))))
|
custom-i))))
|
||||||
|
@ -1753,7 +1754,7 @@
|
||||||
spec))
|
spec))
|
||||||
(set-module-transformer!
|
(set-module-transformer!
|
||||||
module
|
module
|
||||||
(module-ref interface (car
|
(module-ref interface (car
|
||||||
(last-pair (car interface-args)))
|
(last-pair (car interface-args)))
|
||||||
#f)))
|
#f)))
|
||||||
(loop (cddr kws)
|
(loop (cddr kws)
|
||||||
|
@ -1879,7 +1880,7 @@
|
||||||
"Write a Scheme file instead that uses `load-extension'.")
|
"Write a Scheme file instead that uses `load-extension'.")
|
||||||
(issue-deprecation-warning
|
(issue-deprecation-warning
|
||||||
(simple-format #f "(You just autoloaded module ~S.)" modname)))
|
(simple-format #f "(You just autoloaded module ~S.)" modname)))
|
||||||
|
|
||||||
(define (init-dynamic-module modname)
|
(define (init-dynamic-module modname)
|
||||||
;; Register any linked modules which have been registered on the C level
|
;; Register any linked modules which have been registered on the C level
|
||||||
(register-modules #f)
|
(register-modules #f)
|
||||||
|
@ -1942,7 +1943,7 @@
|
||||||
module-name)))))
|
module-name)))))
|
||||||
(let ((subdir (car subdir-and-libname))
|
(let ((subdir (car subdir-and-libname))
|
||||||
(libname (cdr subdir-and-libname)))
|
(libname (cdr subdir-and-libname)))
|
||||||
|
|
||||||
;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that
|
;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that
|
||||||
;; file exists, fetch the dlname from that file and attempt to link
|
;; file exists, fetch the dlname from that file and attempt to link
|
||||||
;; against it. If `subdir/libfoo.la' does not exist, or does not seem
|
;; against it. If `subdir/libfoo.la' does not exist, or does not seem
|
||||||
|
@ -1958,23 +1959,23 @@
|
||||||
(if (and sharlib-full (file-exists? sharlib-full))
|
(if (and sharlib-full (file-exists? sharlib-full))
|
||||||
(link-dynamic-module sharlib-full init)
|
(link-dynamic-module sharlib-full init)
|
||||||
(check-dirs (cdr dir-list)))))))))
|
(check-dirs (cdr dir-list)))))))))
|
||||||
|
|
||||||
(define (try-using-libtool-name libdir libname)
|
(define (try-using-libtool-name libdir libname)
|
||||||
(let ((libtool-filename (in-vicinity libdir
|
(let ((libtool-filename (in-vicinity libdir
|
||||||
(string-append libname ".la"))))
|
(string-append libname ".la"))))
|
||||||
(and (file-exists? libtool-filename)
|
(and (file-exists? libtool-filename)
|
||||||
libtool-filename)))
|
libtool-filename)))
|
||||||
|
|
||||||
(define (try-using-sharlib-name libdir libname)
|
(define (try-using-sharlib-name libdir libname)
|
||||||
(in-vicinity libdir (string-append libname ".so")))
|
(in-vicinity libdir (string-append libname ".so")))
|
||||||
|
|
||||||
(define (link-dynamic-module filename initname)
|
(define (link-dynamic-module filename initname)
|
||||||
;; Register any linked modules which have been registered on the C level
|
;; Register any linked modules which have been registered on the C level
|
||||||
(register-modules #f)
|
(register-modules #f)
|
||||||
(let ((dynobj (dynamic-link filename)))
|
(let ((dynobj (dynamic-link filename)))
|
||||||
(dynamic-call initname dynobj)
|
(dynamic-call initname dynobj)
|
||||||
(register-modules dynobj)))
|
(register-modules dynobj)))
|
||||||
|
|
||||||
(define (try-module-linked module-name)
|
(define (try-module-linked module-name)
|
||||||
(init-dynamic-module module-name))
|
(init-dynamic-module module-name))
|
||||||
|
|
||||||
|
@ -1982,7 +1983,7 @@
|
||||||
(and (find-and-link-dynamic-module module-name)
|
(and (find-and-link-dynamic-module module-name)
|
||||||
(init-dynamic-module module-name))))
|
(init-dynamic-module module-name))))
|
||||||
;; end of deprecated section
|
;; end of deprecated section
|
||||||
|
|
||||||
|
|
||||||
(define autoloads-done '((guile . guile)))
|
(define autoloads-done '((guile . guile)))
|
||||||
|
|
||||||
|
@ -2649,7 +2650,7 @@
|
||||||
'())))
|
'())))
|
||||||
(define (map-apply func list)
|
(define (map-apply func list)
|
||||||
(map (lambda (args) (apply func args)) list))
|
(map (lambda (args) (apply func args)) list))
|
||||||
(define keys
|
(define keys
|
||||||
;; sym key quote?
|
;; sym key quote?
|
||||||
'((:select #:select #t)
|
'((:select #:select #t)
|
||||||
(:renamer #:renamer #f)))
|
(:renamer #:renamer #f)))
|
||||||
|
@ -2700,7 +2701,7 @@
|
||||||
(defmacro define-module args
|
(defmacro define-module args
|
||||||
`(eval-case
|
`(eval-case
|
||||||
((load-toplevel)
|
((load-toplevel)
|
||||||
(let ((m (process-define-module
|
(let ((m (process-define-module
|
||||||
(list ,@(compile-define-module-args args)))))
|
(list ,@(compile-define-module-args args)))))
|
||||||
(set-current-module m)
|
(set-current-module m)
|
||||||
m))
|
m))
|
||||||
|
@ -2785,7 +2786,7 @@
|
||||||
(begin-deprecated
|
(begin-deprecated
|
||||||
(if (not (module-local-variable m name))
|
(if (not (module-local-variable m name))
|
||||||
(let ((v (module-variable m name)))
|
(let ((v (module-variable m name)))
|
||||||
(cond
|
(cond
|
||||||
(v
|
(v
|
||||||
(issue-deprecation-warning
|
(issue-deprecation-warning
|
||||||
"Using `export' to re-export imported bindings is deprecated. Use `re-export' instead.")
|
"Using `export' to re-export imported bindings is deprecated. Use `re-export' instead.")
|
||||||
|
@ -2987,13 +2988,13 @@
|
||||||
(load-emacs-interface))
|
(load-emacs-interface))
|
||||||
|
|
||||||
;; Use some convenient modules (in reverse order)
|
;; Use some convenient modules (in reverse order)
|
||||||
|
|
||||||
(if (provided? 'regex)
|
(if (provided? 'regex)
|
||||||
(module-use! guile-user-module (resolve-interface '(ice-9 regex))))
|
(module-use! guile-user-module (resolve-interface '(ice-9 regex))))
|
||||||
(if (provided? 'threads)
|
(if (provided? 'threads)
|
||||||
(module-use! guile-user-module (resolve-interface '(ice-9 threads))))
|
(module-use! guile-user-module (resolve-interface '(ice-9 threads))))
|
||||||
;; load debugger on demand
|
;; load debugger on demand
|
||||||
(module-use! guile-user-module
|
(module-use! guile-user-module
|
||||||
(make-autoload-interface guile-user-module
|
(make-autoload-interface guile-user-module
|
||||||
'(ice-9 debugger) '(debug)))
|
'(ice-9 debugger) '(debug)))
|
||||||
(module-use! guile-user-module (resolve-interface '(ice-9 session)))
|
(module-use! guile-user-module (resolve-interface '(ice-9 session)))
|
||||||
|
@ -3032,13 +3033,13 @@
|
||||||
(sigaction (car sig-msg)
|
(sigaction (car sig-msg)
|
||||||
(make-handler (cdr sig-msg))))
|
(make-handler (cdr sig-msg))))
|
||||||
signals))))
|
signals))))
|
||||||
|
|
||||||
;; the protected thunk.
|
;; the protected thunk.
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let ((status (scm-style-repl)))
|
(let ((status (scm-style-repl)))
|
||||||
(run-hook exit-hook)
|
(run-hook exit-hook)
|
||||||
status))
|
status))
|
||||||
|
|
||||||
;; call at exit.
|
;; call at exit.
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(map (lambda (sig-msg old-handler)
|
(map (lambda (sig-msg old-handler)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue