mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +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
* 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;
}

12
test-suite/tests/modules.test
View 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
@ -125,7 +125,15 @@
(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)))