mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +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 ;; 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) (define (module-use-interfaces! module interfaces)
(let ((prev (filter (lambda (used) (let* ((cur (module-uses module))
(and-map (lambda (iface) (new (let lp ((in interfaces) (out '()))
(not (eq? used iface))) (if (null? in)
interfaces)) (reverse out)
(module-uses module)))) (lp (cdr in)
(set-module-uses! module (let ((iface (car in)))
(append prev interfaces)) (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)) (hash-clear! (module-import-obarray module))
(module-modified 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))) (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. ;;; Resolve-module.