1
Fork 0
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:
Thien-Thi Nguyen 2001-08-30 23:30:12 +00:00
parent df1cc476e4
commit f9da74b0f6

View file

@ -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)