From 611e4d12abe5305b14ae24e4f135d5fc57ce0e9a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 20 Jan 2013 19:33:42 +0100 Subject: [PATCH] fix try-module-autoload, which did not detect failure to find the file * libguile/load.c (scm_primitive_load_path): If the second argument is a procedure, call it like a thunk. * doc/ref/api-evaluation.texi (Load Paths): Update docs. * module/ice-9/boot-9.scm (resolve-interface): Use `unless'. (try-module-autoload): Use the new primitive-load-path to detect failure to find an appropriate file. Fixes a bug reported by Diogo F. S. Ramos. Thanks to Noah Lavine for tracking it down. --- doc/ref/api-evaluation.texi | 17 ++++++++++------- libguile/load.c | 22 +++++++++++++--------- module/ice-9/boot-9.scm | 29 +++++++++++++++++++++-------- 3 files changed, 44 insertions(+), 24 deletions(-) diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi index 2e5a3d2..17f6ed5 100644 --- a/doc/ref/api-evaluation.texi +++ b/doc/ref/api-evaluation.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 2012 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 2012, 2013 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -881,12 +881,15 @@ relative pathname and is not found in the list of search paths, an error is signalled. Preferentially loads a compiled version of the file, if it is available and up-to-date. -By default or if @var{exception-on-not-found} is true, an exception is -raised if @var{filename} is not found. If @var{exception-on-not-found} -is @code{#f} and @var{filename} is not found, no exception is raised and -@code{#f} is returned. For compatibility with Guile 1.8 and earlier, -the C function takes only one argument, which can be either a string -(the file name) or an argument list. +If @var{filename} is a relative pathname and is not found in the list of +search paths, one of three things may happen, depending on the optional +second argument, @var{exception-on-not-found}. If it is @code{#f}, +@code{#f} will be returned. If it is a procedure, it will be called +with no arguments. Otherwise an error is signalled. + +For compatibility with Guile 1.8 and earlier, the C function takes only +one argument, which can be either a string (the file name) or an +argument list. @end deffn @deffn {Scheme Procedure} %search-load-path filename diff --git a/libguile/load.c b/libguile/load.c index 723f3fd..84b6705 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2008, - * 2009, 2010, 2011, 2012 Free Software Foundation, Inc. + * 2009, 2010, 2011, 2012, 2013 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 @@ -846,11 +846,13 @@ canonical_suffix (SCM fname) SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, (SCM args), "Search @var{%load-path} for the file named @var{filename} and\n" - "load it into the top-level environment. If @var{filename} is a\n" - "relative pathname and is not found in the list of search paths,\n" - "an error is signalled, unless the optional argument\n" - "@var{exception_on_not_found} is @code{#f}, in which case\n" - "@code{#f} is returned instead.") + "load it into the top-level environment.\n\n" + "If @var{filename} is a relative pathname and is not found in\n" + "the list of search paths, one of three things may happen,\n" + "depending on the optional second argument,\n" + "@var{exception_on_not_found}. If it is @code{#f}, @code{#f}\n" + "will be returned. If it is a procedure, it will be called\n" + "with no arguments. Otherwise an error is signalled.") #define FUNC_NAME s_scm_primitive_load_path { SCM filename, exception_on_not_found; @@ -924,11 +926,13 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, if (scm_is_false (full_filename) && scm_is_false (compiled_filename)) { - if (scm_is_true (exception_on_not_found)) + if (scm_is_true (scm_procedure_p (exception_on_not_found))) + return scm_call_0 (exception_on_not_found); + else if (scm_is_false (exception_on_not_found)) + return SCM_BOOL_F; + else SCM_MISC_ERROR ("Unable to find file ~S in load path", scm_list_1 (filename)); - else - return SCM_BOOL_F; } if (!scm_is_false (hook)) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index e426374..77bb84a 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1,7 +1,7 @@ ;;; -*- mode: scheme; coding: utf-8; -*- ;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;;;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 +;;;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 ;;;; Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -2593,8 +2593,8 @@ VALUE." version) (let* ((module (resolve-module name #t version #:ensure #f)) (public-i (and module (module-public-interface module)))) - (and (or (not module) (not public-i)) - (error "no code for module" name)) + (unless public-i + (error "no code for module" name)) (if (and (not select) (null? hide) (eq? renamer identity)) public-i (let ((selection (or select (module-map (lambda (sym var) sym) @@ -2765,10 +2765,13 @@ module '(ice-9 q) '(make-q q-length))}." (define autoloads-in-progress '()) -;; This function is called from "modules.c". If you change it, be -;; sure to update "modules.c" as well. - +;; This function is called from scm_load_scheme_module in +;; "deprecated.c". Please do not change its interface. +;; (define* (try-module-autoload module-name #:optional version) + "Try to load a module of the given name. If it is not found, return +#f. Otherwise return #t. May raise an exception if a file is found, +but it fails to load." (let* ((reverse-name (reverse module-name)) (name (symbol->string (car reverse-name))) (dir-hint-module-name (reverse (cdr reverse-name))) @@ -2785,6 +2788,13 @@ module '(ice-9 q) '(make-q q-length))}." (with-fluids ((current-reader #f)) (save-module-excursion (lambda () + (define (call/ec proc) + (let ((tag (make-prompt-tag))) + (call-with-prompt + tag + (lambda () + (proc (lambda () (abort-to-prompt tag)))) + (lambda (k) (values))))) ;; The initial environment when loading a module is a fresh ;; user module. (set-current-module (make-fresh-user-module)) @@ -2794,8 +2804,11 @@ module '(ice-9 q) '(make-q q-length))}." ;; out how to locate the compiled file, do auto-compilation, ;; etc. Punt for now, and don't use versions when locating ;; the file. - (primitive-load-path (in-vicinity dir-hint name) #f) - (set! didit #t))))) + (call/ec + (lambda (abort) + (primitive-load-path (in-vicinity dir-hint name) + abort) + (set! didit #t))))))) (lambda () (set-autoloaded! dir-hint name didit))) didit)))) -- 1.7.10.4