Fix `module-reverse-lookup'.
authorLudovic Courtès <ludo@gnu.org>
Thu, 8 Apr 2010 17:17:25 +0000 (19:17 +0200)
committerLudovic Courtès <ludo@gnu.org>
Thu, 8 Apr 2010 22:32:14 +0000 (00:32 +0200)
* libguile/modules.c (scm_module_reverse_lookup): Type-check VARIABLE.
  Don't traverse the `uses' list when MODULE is #f.

* test-suite/tests/modules.test ("foundations")["module-reverse-lookup
  [pre-module-obarray]", "module-reverse-lookup [wrong-type-arg]"]: New
  tests.

libguile/modules.c
test-suite/tests/modules.test

index 545281a..fc6ff3b 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008,2009 Free Software Foundation, Inc.
+/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008,2009,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
@@ -801,6 +801,8 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
       obarray = SCM_MODULE_OBARRAY (module);
     }
 
+  SCM_VALIDATE_VARIABLE (SCM_ARG2, variable);
+
   if (!SCM_HASHTABLE_P (obarray))
       return SCM_BOOL_F;
 
@@ -830,17 +832,18 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
        }
     }
 
-  /* Try the `uses' list.  */
-  {
-    SCM uses = SCM_MODULE_USES (module);
-    while (scm_is_pair (uses))
-      {
-       SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
-       if (scm_is_true (sym))
-         return sym;
-       uses = SCM_CDR (uses);
-      }
-  }
+  if (!scm_is_false (module))
+    {
+      /* Try the `uses' list.  */
+      SCM uses = SCM_MODULE_USES (module);
+      while (scm_is_pair (uses))
+       {
+         SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
+         if (scm_is_true (sym))
+           return sym;
+         uses = SCM_CDR (uses);
+       }
+    }
 
   return SCM_BOOL_F;
 }
index f22cfe9..ebcafe3 100644 (file)
@@ -1,6 +1,6 @@
 ;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*-
 
-;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009, 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
               (map module-variable
                    (map resolve-interface mods)
                    syms)
-              locals))))
+              locals)))
+
+  (pass-if "module-reverse-lookup [pre-module-obarray]"
+    (let ((var (module-variable (current-module) 'string?)))
+      (eq? 'string? (module-reverse-lookup #f var))))
+
+  (pass-if-exception "module-reverse-lookup [wrong-type-arg]"
+    exception:wrong-type-arg
+    (module-reverse-lookup (current-module) 'foo)))
 
 
 \f