1
Fork 0
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:
Andy Wingo 2011-03-03 11:29:27 +01:00
parent 51c0fd8086
commit 8d795c83d4
2 changed files with 57 additions and 8 deletions

View file

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

View file

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