Many thanks for all helpful comments.
Attached is the revised patch.
What's the reason that chain-assoc-get is defined separately in
lily-library.scm:210, though ly_chain_assoc_get exists?
Regards,
Michael
>From 740bd0fcb035099086e9e60a325019fdf25595d4 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Michael=20K=C3=A4ppler?= <xmichae...@web.de>
Date: Sat, 12 Sep 2009 20:36:58 +0200
Subject: [PATCH] Improve error checking in ly:assoc-get and ly:chain-assoc-get.
* Introduce a new optional argument strict_checking
* When strict_checking is set to true, output a programming_error
if the given key is not found in the given alist / achain.
* This patch does not change the current behaviour. It prepares
a greater modification to remove all assoc calls through
secure assoc-get calls.
---
lily/general-scheme.cc | 38 +++++++++++++++++++++++++++++---------
lily/include/lily-guile.hh | 4 ++--
2 files changed, 31 insertions(+), 11 deletions(-)
diff --git a/lily/general-scheme.cc b/lily/general-scheme.cc
index 43ff745..7372ce6 100644
--- a/lily/general-scheme.cc
+++ b/lily/general-scheme.cc
@@ -154,10 +154,12 @@ LY_DEFINE (ly_dir_p, "ly:dir?",
}
LY_DEFINE (ly_assoc_get, "ly:assoc-get",
- 2, 1, 0,
- (SCM key, SCM alist, SCM default_value),
- "Return value if @var{key} in @var{alist}, else @code{default-value}"
- " (or @code{#f} if not specified).")
+ 2, 2, 0,
+ (SCM key, SCM alist, SCM default_value, SCM strict_checking),
+ "Return value if @var{key} in @var{alist}, else @var{default_value}"
+ " (or @code{#f} if not specified). If @var{strict_checking} is set"
+ " to @code{#t} and @var{key} is not in @var{alist}, a programming_error"
+ " is output.")
{
LY_ASSERT_TYPE(ly_cheap_is_list, alist, 2);
@@ -168,6 +170,14 @@ LY_DEFINE (ly_assoc_get, "ly:assoc-get",
if (default_value == SCM_UNDEFINED)
default_value = SCM_BOOL_F;
+ if (strict_checking == SCM_BOOL_T)
+ {
+ string key_string = ly_scm2string (scm_object_to_string (key, SCM_UNDEFINED));
+ string default_value_string = ly_scm2string (scm_object_to_string (default_value, SCM_UNDEFINED));
+ programming_error (to_string ("Cannot find key `%s' in alist, setting to `%s'.",
+ key_string, default_value_string));
+ }
+
return default_value;
}
@@ -312,10 +322,11 @@ LY_DEFINE (ly_effective_prefix, "ly:effective-prefix",
}
LY_DEFINE (ly_chain_assoc_get, "ly:chain-assoc-get",
- 2, 1, 0, (SCM key, SCM achain, SCM val),
+ 2, 2, 0, (SCM key, SCM achain, SCM default_value, SCM strict_checking),
"Return value for @var{key} from a list of alists @var{achain}."
- " If no entry is found, return @var{val} or @code{#f} if"
- " @var{val} is not specified.")
+ " If no entry is found, return @var{default_value} or @code{#f} if"
+ " @var{default_value} is not specified. With @var{strict_checking}"
+ " set to @code{#t}, a programming_error is output in such cases.")
{
if (scm_is_pair (achain))
{
@@ -323,9 +334,18 @@ LY_DEFINE (ly_chain_assoc_get, "ly:chain-assoc-get",
if (scm_is_pair (handle))
return scm_cdr (handle);
else
- return ly_chain_assoc_get (key, scm_cdr (achain), val);
+ return ly_chain_assoc_get (key, scm_cdr (achain), default_value);
}
- return val == SCM_UNDEFINED ? SCM_BOOL_F : val;
+
+ if (strict_checking == SCM_BOOL_T)
+ {
+ string key_string = ly_scm2string (scm_object_to_string (key, SCM_UNDEFINED));
+ string default_value_string = ly_scm2string (scm_object_to_string (default_value, SCM_UNDEFINED));
+ programming_error (to_string ("Cannot find key `%s' in achain, setting to `%s'.",
+ key_string, default_value_string));
+ }
+
+ return default_value == SCM_UNDEFINED ? SCM_BOOL_F : default_value;
}
diff --git a/lily/include/lily-guile.hh b/lily/include/lily-guile.hh
index 88c7fe8..859131a 100644
--- a/lily/include/lily-guile.hh
+++ b/lily/include/lily-guile.hh
@@ -48,9 +48,9 @@ SCM ly_rational2scm (Rational);
SCM ly_offset2scm (Offset);
Offset ly_scm2offset (SCM);
SCM ly_chain_assoc (SCM key, SCM achain);
-SCM ly_chain_assoc_get (SCM key, SCM achain, SCM val);
+SCM ly_chain_assoc_get (SCM key, SCM achain, SCM default_value, SCM strict_checking = SCM_BOOL_F);
SCM ly_assoc_cdr (SCM key, SCM alist);
-SCM ly_assoc_get (SCM key, SCM alist, SCM def);
+SCM ly_assoc_get (SCM key, SCM alist, SCM default_value, SCM strict_checking = SCM_BOOL_F);
Interval ly_scm2interval (SCM);
Drul_array<Real> ly_scm2realdrul (SCM);
Slice int_list_to_slice (SCM l);
--
1.6.0.2
_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-devel
