mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 08:10:17 +02:00
Code Activity

Fix `module-reverse-lookup'.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2010-04-08 19:17:25 +02:00
parent 6c76da4c32
commit 1606312f9a
2 changed files with 25 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

27
libguile/modules.c
View 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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); obarray = SCM_MODULE_OBARRAY (module);
} }
SCM_VALIDATE_VARIABLE (SCM_ARG2, variable);
if (!SCM_HASHTABLE_P (obarray)) if (!SCM_HASHTABLE_P (obarray))
return SCM_BOOL_F; return SCM_BOOL_F;
@ -830,17 +832,18 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
} }
} }
/* Try the `uses' list. */ if (!scm_is_false (module))
{ {
SCM uses = SCM_MODULE_USES (module); /* Try the `uses' list. */
while (scm_is_pair (uses)) 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)) SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
return sym; if (scm_is_true (sym))
uses = SCM_CDR (uses); return sym;
} uses = SCM_CDR (uses);
} }
}
return SCM_BOOL_F; return SCM_BOOL_F;
} }

12
test-suite/tests/modules.test
View file

@ -1,6 +1,6 @@
;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -125,7 +125,15 @@
(map module-variable (map module-variable
(map resolve-interface mods) (map resolve-interface mods)
syms) 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)))