diff options
author | Andy Wingo <wingo@pobox.com> | 2011-03-03 11:29:27 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-03-03 11:29:27 +0100 |
commit | 8d795c83d463e893cdac16733fd42bef809c0d79 (patch) | |
tree | a36ad22a98d52094da23b7387fd13864e85b8761 | |
parent | 51c0fd808683fdea689a91fb13b367fd98998c7a (diff) | |
download | guile-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.scm | 20 | ||||
-rw-r--r-- | test-suite/tests/modules.test | 45 |
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. ;;; |