From: Andy Wingo <wingo@pobox.com>
Date: Thu, 3 Mar 2011 10:29:27 +0000 (+0100)
Subject: more module-use-interfaces! tweaks
X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/8d795c83d463e893cdac16733fd42bef809c0d79

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

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
@@ -145,6 +145,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.
 ;;;