mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

more module-use-interfaces! tweaks

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

20
module/ice-9/boot-9.scm
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)))

45
test-suite/tests/modules.test
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.