summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-03-03 11:29:27 +0100
committerAndy Wingo <wingo@pobox.com>2011-03-03 11:29:27 +0100
commit8d795c83d463e893cdac16733fd42bef809c0d79 (patch)
treea36ad22a98d52094da23b7387fd13864e85b8761
parent51c0fd808683fdea689a91fb13b367fd98998c7a (diff)
downloadguile-8d795c83d463e893cdac16733fd42bef809c0d79.tar.gz
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.
-rw-r--r--module/ice-9/boot-9.scm20
-rw-r--r--test-suite/tests/modules.test45
2 files changed, 57 insertions, 8 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index fbad99b8c..7ca08062f 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -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)))
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index 29abd093a..5f34d9e70 100644
--- a/test-suite/tests/modules.test
+++ b/test-suite/tests/modules.test
@@ -146,6 +146,51 @@
;;;
+;;; 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.
;;;