[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-308-ga148c75

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a148c752ba7adf0d2005cc7bc5928a2dde467609

The branch, master has been updated
       via  a148c752ba7adf0d2005cc7bc5928a2dde467609 (commit)
      from  dcb68c09d03cf9006c8e2c21c726a3f35be026bd (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit a148c752ba7adf0d2005cc7bc5928a2dde467609
Author: Jose A. Ortega Ruiz <address@hidden>
Date:   Tue Aug 31 14:13:43 2010 +0200

    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 <address@hidden>

-----------------------------------------------------------------------

Summary of changes:
 module/ice-9/session.scm      |   11 +-------
 test-suite/Makefile.am        |    1 +
 test-suite/tests/session.test |   53 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 56 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 6926149..c504587 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -101,6 +101,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..1697471
--- /dev/null
+++ b/test-suite/tests/session.test
@@ -0,0 +1,53 @@
+;;;; session.test --- test suite for (ice-9 session)   -*- scheme -*-
+;;;; Jose Antonio Ortega Ruiz <address@hidden> -- 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)
+  (call/cc (lambda (k)
+             (apropos-fold-all (lambda (m _)
+                                 (and (not (module? m)) (k #f))
+                                 (and (eq? m mod) (k #t)))
+                               #f))))
+(define (find-mod-name mod-name)
+  (find-module (resolve-module mod-name #f #:ensure #f)))
+
+
+(with-test-prefix "apropos-fold-all"
+  (pass-if "a root module: ice-9" (find-mod-name '(ice-9)))
+  (pass-if "a child of test-suite" (find-mod-name '(test-suite lib)))
+  (pass-if "a non-module" (not (find-mod-name '(ice-999-0))))
+  (pass-if "a childish non-module" (not (find-mod-name '(ice-9 ice-999-0))))
+  (pass-if "an anonymous module" (find-mod-name (module-name (make-module)))))
+
+(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))))


hooks/post-receive
-- 
GNU Guile