+
+LY_DEFINE (ly_expect_warning, "ly:expect-warning",
+ 1, 0, 1, (SCM str, SCM rest),
+ "A Scheme callable function to register a warning to be expected"
+ " and subsequently suppressed. If the warning is not encountered,"
+ " a warning about the missing warning will be shown. The message"
+ " should be translated with @code{(_ ...)} and changing parameters"
+ " given after the format string.")
+{
+ LY_ASSERT_TYPE (scm_is_string, str, 1);
+ str = scm_simple_format (SCM_BOOL_F, str, rest);
+ expect_warning (ly_scm2string (str));
+ return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_check_expected_warnings, "ly:check-expected-warnings",
+ 0, 0, 0, (),
+ "Check whether all expected warnings have really been triggered.")
+{
+ check_expected_warnings ();
+ return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_translate_cpp_warning_scheme, "ly:translate-cpp-warning-scheme",
+ 1, 0, 0, (SCM str),
+ "Translates a string in C++ printf format and modifies it to use"
+ " it for scheme formatting.")
+{
+ LY_ASSERT_TYPE (scm_is_string, str, 1);
+ string s = _ (ly_scm2string (str).c_str ());
+
+ /* Now replace all printf placeholders by scheme placeholders (~a).
+ * Guile's format syntax is pretty similar to C's printf, only with
+ * a tilde as the placeholder instead of a percent sign.
+ * There is no easy way to replace all ~ -> ~~, %% -> %, % -> ~,
+ * so simply walk through each character.
+ */
+// size_t pos = 0;
+ const char *pos = s.c_str ();
+ string result = "";
+ while (*pos != '\0')
+ {
+ // In some cases (%%, %s) we need to do a lookahead. As the C string is
+ // always \0-terminated the next char is never beyond the end of the
+ // memory!
+ switch (*pos) {
+ case '~':
+ result += "~~";
+ break;
+ case '%':
+ if (*(pos+1) == '%') {
+ result += "%";
+ // Skip the second '%'
+ pos++;
+ } else if (*(pos+1) == 's' || *(pos+1) == 'd') {
+ // %s in C++ corresponds to ~a; ~s would add quotes!
+ // ~d is only supported by ice-9, use ~a instead
+ result += "~a";
+ // Skip the following 's'
+ pos++;
+ } else
+ result += "~";
+ break;
+ default:
+ result += *pos;
+ }
+ pos++;
+ }
+ return ly_string2scm (result);
+}