From 017eb4a6be938c50df7fe6a27ca38486e75e02d5 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 9 Jan 2012 16:07:46 +0100 Subject: [PATCH] primitive-load returns the value(s) of the last expression * libguile/load.c (scm_primitive_load): Return the values yielded from evaluating the last expression in the file. * test-suite/tests/load.test ("return value of `load'"): Add tests. --- libguile/load.c | 12 ++++++++---- test-suite/tests/load.test | 20 +++++++++++++++++--- 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/libguile/load.c b/libguile/load.c index a40031898..007621883 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -87,7 +87,9 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, #define FUNC_NAME s_scm_primitive_load { SCM hook = *scm_loc_load_hook; + SCM ret = SCM_UNSPECIFIED; char *encoding; + SCM_VALIDATE_STRING (1, filename); if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook))) SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f", @@ -96,8 +98,10 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, if (!scm_is_false (hook)) scm_call_1 (hook, filename); - { /* scope */ - SCM port = scm_open_file (filename, scm_from_locale_string ("r")); + { + SCM port; + + port = scm_open_file (filename, scm_from_locale_string ("r")); scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); scm_i_dynwind_current_load_port (port); @@ -124,13 +128,13 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, if (SCM_EOF_OBJECT_P (form)) break; - scm_primitive_eval_x (form); + ret = scm_primitive_eval_x (form); } scm_dynwind_end (); scm_close_port (port); } - return SCM_UNSPECIFIED; + return ret; } #undef FUNC_NAME diff --git a/test-suite/tests/load.test b/test-suite/tests/load.test index 50e5fa73f..1cf8d65e8 100644 --- a/test-suite/tests/load.test +++ b/test-suite/tests/load.test @@ -1,7 +1,7 @@ ;;;; load.test --- test LOAD and path searching functions -*- scheme -*- ;;;; Jim Blandy --- September 1999 ;;;; -;;;; Copyright (C) 1999, 2001, 2006, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006, 2010, 2012 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 @@ -18,8 +18,9 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite test-load) - :use-module (test-suite lib) - :use-module (test-suite guile-test)) + #:use-module (test-suite lib) + #:use-module (test-suite guile-test) + #:use-module (system base compile)) (define temp-dir (data-file-name "load-test.dir")) @@ -124,4 +125,17 @@ (try-search-with-extensions path "ugly.scm" extensions "dir3/ugly.scm") (try-search-with-extensions path "ugly.ss" extensions #f)) +(with-test-prefix "return value of `load'" + (let ((temp-file (in-vicinity temp-dir "foo.scm"))) + (call-with-output-file temp-file + (lambda (port) + (write '(+ 2 3) port) + (newline port))) + (pass-if "primitive-load" + (equal? 5 (primitive-load temp-file))) + (let ((temp-compiled-file (in-vicinity temp-dir "foo.go"))) + (compile-file temp-file #:output-file temp-compiled-file) + (pass-if "load-compiled" + (equal? 5 (load-compiled temp-compiled-file)))))) + (delete-tree temp-dir)