Issue 4376: Add LY_ASSERT_DERIVED_SMOB macro

When LY_ASSERT_SMOB is called with a class that is actually derived from
some smobified base class providing is_smob and unsmob, the resulting
check and error message are inaccurate.  This patch uses dynamic_cast to
implement a separate LY_ASSERT_DERIVED_SMOB attaining sensible behavior
in that case.  When no derivation is involved, the performance impact is
minimal.

diff --git a/lily/include/lily-guile-macros.hh b/lily/include/lily-guile-macros.hh
index 355bd58139b8474955b6f914846de20bdb875fb3..10520d6dc9cfbc3dfb0fc3501f10ca687e2a9401 100644 (file)
--- a/lily/include/lily-guile-macros.hh
+++ b/lily/include/lily-guile-macros.hh
@@ -235,6 +235,23 @@ void ly_check_name (const string &cxx, const string &fname);
       }                                                                 \
   }
 
-#define LY_ASSERT_SMOB(klass, var, number) LY_ASSERT_TYPE(klass::is_smob, var, number)
+void ly_wrong_smob_arg (bool pred (SCM), SCM var, int number, const char *fun);
+
+// Could be just implemented using LY_ASSERT_TYPE, but this variant
+// saves a slight amount of code
+
+#define LY_ASSERT_SMOB(klass, var, number)                              \
+  {                                                                     \
+    if (!klass::is_smob (var))                                          \
+      ly_wrong_smob_arg (klass::is_smob, var, number, __FUNCTION__);    \
+  }
+
+// This variant is for the case where klass::unsmob might actually be
+// situated in a base class of klass
+#define LY_ASSERT_DERIVED_SMOB(klass, var, number)                      \
+  {                                                                     \
+    if (!derived_unsmob<klass> (var))                                   \
+      ly_wrong_smob_arg (klass::is_smob, var, number, __FUNCTION__);    \
+  }
 
 #endif /* LILY_GUILE_MACROS_HH */

diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index 6f7bf37f709f072594426b884827e0e2cd9b2515..d8d8d10edba05276889af19161e3a25b205e837b 100644 (file)
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -449,6 +449,23 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol)
   return true;
 }
 
+void
+ly_wrong_smob_arg (bool pred (SCM), SCM var, int number, const char *fun)
+{
+  string type = predicate_to_typename ((void *) pred);
+  if (pred (var))
+    {
+      // Uh oh.  derived_unsmob <T> delivered 0, yet
+      // T::is_smob delivers true.  This means that T::is_smob is a
+      // matching check from a base class of T, but var is of an
+      // incompatible derived type.
+      type = string (_ ("Wrong kind of ")).append (type);
+    }
+  scm_wrong_type_arg_msg (mangle_cxx_identifier (fun).c_str (),
+                          number, var, type.c_str ());
+}
+
+
 /* some SCM abbrevs
 
 zijn deze nou handig?