summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-06-05 00:25:39 +0200
committerLudovic Courtès <ludo@gnu.org>2013-06-05 00:25:39 +0200
commit79a9a2c271f18d1cd2031b23c682dadd0cf31bae (patch)
tree3159f2c56aa96365d819e687bc0862ed6460a9d7
parent4af0d97ee65f298be33d5959cd36a5bea8797be9 (diff)
downloadguile-79a9a2c271f18d1cd2031b23c682dadd0cf31bae.tar.gz
Report the faulty keyword in errors raised by `scm_c_bind_keyword_arguments'.
Reported by Mark H. Weaver. * libguile/keywords.c (scm_c_bind_keyword_arguments): Use `scm_error_scm' instead of `scm_error'. Pass the faulty keyword enclosed in a list as the last argument. * test-suite/tests/optargs.test ("scm_c_bind_keyword_arguments"): New test prefix.
-rw-r--r--libguile/keywords.c20
-rw-r--r--test-suite/tests/optargs.test16
2 files changed, 28 insertions, 8 deletions
diff --git a/libguile/keywords.c b/libguile/keywords.c
index ab6634c42..f7a395da3 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
+ * 2006, 2008, 2009, 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
* as published by the Free Software Foundation; either version 3 of
@@ -157,9 +158,11 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest,
{
/* KW_OR_ARG is not in the list of expected keywords. */
if (!(flags & SCM_ALLOW_OTHER_KEYS))
- scm_error (scm_keyword_argument_error,
- subr, "Unrecognized keyword",
- SCM_EOL, SCM_BOOL_F);
+ scm_error_scm (scm_keyword_argument_error,
+ scm_from_locale_string (subr),
+ scm_from_latin1_string
+ ("Unrecognized keyword"),
+ SCM_EOL, scm_list_1 (kw_or_arg));
break;
}
arg_p = va_arg (va, SCM *);
@@ -181,9 +184,10 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest,
/* The next argument is not a keyword, or is a singleton
keyword at the end of REST. */
if (!(flags & SCM_ALLOW_NON_KEYWORD_ARGUMENTS))
- scm_error (scm_keyword_argument_error,
- subr, "Invalid keyword",
- SCM_EOL, SCM_BOOL_F);
+ scm_error_scm (scm_keyword_argument_error,
+ scm_from_locale_string (subr),
+ scm_from_latin1_string ("Invalid keyword"),
+ SCM_EOL, scm_list_1 (kw_or_arg));
/* Advance REST. */
rest = tail;
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index b8f21c470..047417b4c 100644
--- a/test-suite/tests/optargs.test
+++ b/test-suite/tests/optargs.test
@@ -169,6 +169,22 @@
(equal? (f 1 2 3 #:x 'x #:z 'z)
'(x #f z (1 2 3 #:x x #:z z))))))
+(with-test-prefix "scm_c_bind_keyword_arguments"
+
+ (pass-if-equal "unrecognized keyword" '(#:y)
+ (catch 'keyword-argument-error
+ (lambda ()
+ (open-file "/dev/null" "r" #:y 'not-recognized))
+ (lambda (key proc fmt args data)
+ data)))
+
+ (pass-if-equal "invalid keyword" '(not-a-keyword)
+ (catch 'keyword-argument-error
+ (lambda ()
+ (open-file "/dev/null" "r" 'not-a-keyword 'something))
+ (lambda (key proc fmt args data)
+ data))))
+
(with-test-prefix/c&e "lambda* inits"
(pass-if "can bind lexicals within inits"
(begin