Re: [PATCH] Fix for `submodules' in (ice-9 session) (closes #30062)

[Jose A. Ortega Ruiz]

On Tue, Aug 31 2010, Andy Wingo wrote:

> Hi,
>
> Can you submit a test please, also? This patch is correct, but with
> --enable-deprecated builds, it should be unnecessary.

Okay, test added (i'm not sure if there's something to do about
--enable-deprecated builds), and patch attached.

Cheers,
jao

>From b29148d72882e5840fbe9242ccbd17be14f42545 Mon Sep 17 00:00:00 2001
From: Jose A. Ortega Ruiz <address@hidden>
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 <address@hidden>
---
 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 <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-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