From b29148d72882e5840fbe9242ccbd17be14f42545 Mon Sep 17 00:00:00 2001 From: Jose A. Ortega Ruiz Date: Tue, 31 Aug 2010 14:13:43 +0200 Subject: [PATCH] Fix for `submodules' in (ice-9 session) (closes #30062) * module/ice-9/session.scm (submodules): replace implementation to use `module-submodules' instead of `module-obarray' (the latter doesn't include submodules anymore). * test-suite/tests/session.test: new test suite for session, checking the exported procedures that use `submodules'. Signed-off-by: Jose A. Ortega Ruiz --- module/ice-9/session.scm | 11 +------- test-suite/Makefile.am | 1 + test-suite/tests/session.test | 50 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 53 insertions(+), 9 deletions(-) create mode 100644 test-suite/tests/session.test diff --git a/module/ice-9/session.scm b/module/ice-9/session.scm index 10ce613..36aeb99 100644 --- a/module/ice-9/session.scm +++ b/module/ice-9/session.scm @@ -406,15 +406,8 @@ It is an image under the mapping EXTRACT." (define (root-modules) (submodules (resolve-module '() #f))) -(define (submodules m) - (hash-fold (lambda (name var data) - (let ((obj (and (variable-bound? var) (variable-ref var)))) - (if (and (module? obj) - (eq? (module-kind obj) 'directory)) - (cons obj data) - data))) - '() - (module-obarray m))) +(define (submodules mod) + (hash-map->list (lambda (k v) v) (module-submodules mod))) (define apropos-fold-exported (make-fold-modules root-modules submodules module-public-interface)) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index eaa7512..c779eac 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -100,6 +100,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/reader.test \ tests/receive.test \ tests/regexp.test \ + tests/session.test \ tests/signals.test \ tests/socket.test \ tests/srcprop.test \ diff --git a/test-suite/tests/session.test b/test-suite/tests/session.test new file mode 100644 index 0000000..5493209 --- /dev/null +++ b/test-suite/tests/session.test @@ -0,0 +1,50 @@ +;;;; session.test --- test suite for (ice-9 session) -*- scheme -*- +;;;; Jose Antonio Ortega Ruiz -- August 2010 +;;;; +;;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +;;;; 02110-1301 USA + +(define-module (test-suite session) + #:use-module (test-suite lib) + #:use-module (ice-9 session)) + +(define (find-module mod-name) + (let ((mod (resolve-module mod-name #f #:ensure #f))) + (call/cc (lambda (k) + (apropos-fold-all (lambda (m _) + (and (not (module? m)) (k #f)) + (and (eq? m mod) (k #t))) + #f))))) + +(with-test-prefix "apropos-fold-all" + (pass-if "a root module: ice-9" (find-module '(ice-9))) + (pass-if "a child of test-suite" (find-module '(test-suite lib))) + (pass-if "a non-module" (not (find-module '(ice-999-0)))) + (pass-if "a childish non-module" (not (find-module '(ice-9 ice-999-0))))) + +(define (find-interface mod-name) + (let* ((mod (resolve-module mod-name #f #:ensure #f)) + (ifc (and mod (module-public-interface mod)))) + (and ifc + (call/cc (lambda (k) + (apropos-fold-exported (lambda (i _) + (and (eq? i ifc) (k #t))) + #f)))))) + +(with-test-prefix "apropos-fold-exported" + (pass-if "a child of test-suite" (find-interface '(test-suite lib))) + (pass-if "a child of ice-9" (find-interface '(ice-9 session)))) -- 1.7.1