mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 21:40:33 +02:00
more module-use-interfaces! tweaks
* module/ice-9/boot-9.scm (module-use-interfaces!): Fix up to prevent duplication in the use list of multiple incoming interfaces. * test-suite/tests/modules.test ("module-use"): Add tests.
This commit is contained in:
parent
51c0fd8086
commit
8d795c83d4
2 changed files with 57 additions and 8 deletions
|
@ -1994,16 +1994,20 @@ VALUE."
|
|||
|
||||
;; MODULE-USE-INTERFACES! module interfaces
|
||||
;;
|
||||
;; Same as MODULE-USE! but add multiple interfaces and check for duplicates
|
||||
;; Same as MODULE-USE!, but only notifies module observers after all
|
||||
;; interfaces are added to the inports list.
|
||||
;;
|
||||
(define (module-use-interfaces! module interfaces)
|
||||
(let ((prev (filter (lambda (used)
|
||||
(and-map (lambda (iface)
|
||||
(not (eq? used iface)))
|
||||
interfaces))
|
||||
(module-uses module))))
|
||||
(set-module-uses! module
|
||||
(append prev interfaces))
|
||||
(let* ((cur (module-uses module))
|
||||
(new (let lp ((in interfaces) (out '()))
|
||||
(if (null? in)
|
||||
(reverse out)
|
||||
(lp (cdr in)
|
||||
(let ((iface (car in)))
|
||||
(if (or (memq iface cur) (memq iface out))
|
||||
out
|
||||
(cons iface out))))))))
|
||||
(set-module-uses! module (append cur new))
|
||||
(hash-clear! (module-import-obarray module))
|
||||
(module-modified module)))
|
||||
|
||||
|
|
|
@ -144,6 +144,51 @@
|
|||
(eq? (module-public-interface the-scm-module) the-scm-module)))
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;;; module-use! / module-use-interfaces!
|
||||
;;;
|
||||
(with-test-prefix "module-use"
|
||||
(let ((m (make-module)))
|
||||
(pass-if "no uses initially"
|
||||
(null? (module-uses m)))
|
||||
|
||||
(pass-if "using ice-9 q"
|
||||
(begin
|
||||
(module-use! m (resolve-interface '(ice-9 q)))
|
||||
(equal? (module-uses m)
|
||||
(list (resolve-interface '(ice-9 q))))))
|
||||
|
||||
(pass-if "using ice-9 q again"
|
||||
(begin
|
||||
(module-use! m (resolve-interface '(ice-9 q)))
|
||||
(equal? (module-uses m)
|
||||
(list (resolve-interface '(ice-9 q))))))
|
||||
|
||||
(pass-if "using ice-9 ftw"
|
||||
(begin
|
||||
(module-use-interfaces! m (list (resolve-interface '(ice-9 ftw))))
|
||||
(equal? (module-uses m)
|
||||
(list (resolve-interface '(ice-9 q))
|
||||
(resolve-interface '(ice-9 ftw))))))
|
||||
|
||||
(pass-if "using ice-9 ftw again"
|
||||
(begin
|
||||
(module-use-interfaces! m (list (resolve-interface '(ice-9 ftw))))
|
||||
(equal? (module-uses m)
|
||||
(list (resolve-interface '(ice-9 q))
|
||||
(resolve-interface '(ice-9 ftw))))))
|
||||
|
||||
(pass-if "using ice-9 control twice"
|
||||
(begin
|
||||
(module-use-interfaces! m (list (resolve-interface '(ice-9 control))
|
||||
(resolve-interface '(ice-9 control))))
|
||||
(equal? (module-uses m)
|
||||
(list (resolve-interface '(ice-9 q))
|
||||
(resolve-interface '(ice-9 ftw))
|
||||
(resolve-interface '(ice-9 control))))))))
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;;; Resolve-module.
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue