From: Joe Neeman <joeneeman@gmail.com>
Date: Tue, 20 Feb 2007 21:27:03 +0000 (+1100)
Subject: More debugging output for cyclic callbacks
X-Git-Tag: release/2.11.20-1~14^2~3
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=ff2acf5c991207bec0eb48a8c37c217d08ced31e;p=lilypond.git

More debugging output for cyclic callbacks
---

diff --git a/lily/grob-property.cc b/lily/grob-property.cc
index 084ea42fbd..6a8faad0c1 100644
--- a/lily/grob-property.cc
+++ b/lily/grob-property.cc
@@ -19,6 +19,10 @@
 #include "profile.hh"
 #include "simple-closure.hh"
 #include "warn.hh"
+#include "protected-scm.hh"
+
+Protected_scm grob_property_callback_stack = SCM_EOL;
+extern bool debug_property_callbacks;
 
 #ifndef NDEBUG
 static SCM modification_callback = SCM_EOL;
@@ -139,6 +143,14 @@ Grob::internal_get_property_data (SCM sym) const
   return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle);
 }
 
+static void
+print_property_callback_stack ()
+{
+  int frame = 0;
+  for (SCM s = grob_property_callback_stack; scm_is_pair (s); s = scm_cdr (s))
+    message (_f ("%d: %s", frame++, ly_scm_write_string (scm_car (s)).c_str ()));
+}
+
 SCM
 Grob::internal_get_property (SCM sym) const
 {
@@ -146,9 +158,16 @@ Grob::internal_get_property (SCM sym) const
 
 #ifndef NDEBUG
   if (val == ly_symbol2scm ("calculation-in-progress"))
-    programming_error (_f ("cyclic dependency: calculation-in-progress encountered for #'%s (%s)",
-			   ly_symbol2string (sym).c_str (),
-			   name ().c_str ()));
+    {
+      programming_error (_f ("cyclic dependency: calculation-in-progress encountered for #'%s (%s)",
+			     ly_symbol2string (sym).c_str (),
+			     name ().c_str ()));
+      if (debug_property_callbacks)
+	{
+	  message ("backtrace: ");
+	  print_property_callback_stack ();
+	}
+    }
 #endif
   
   if (ly_is_procedure (val)
@@ -161,13 +180,6 @@ Grob::internal_get_property (SCM sym) const
   return val;
 }
 
-#ifndef NDEBUG
-#include "protected-scm.hh"
-
-Protected_scm grob_property_callback_stack = SCM_EOL;
-bool debug_property_callbacks = 0;
-#endif
-
 SCM
 Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
 {      
@@ -180,7 +192,7 @@ Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
 
 #ifndef NDEBUG
   if (debug_property_callbacks)
-    grob_property_callback_stack = scm_acons (sym, proc, grob_property_callback_stack);
+    grob_property_callback_stack = scm_cons (scm_list_3 (self_scm (), sym, proc), grob_property_callback_stack);
 #endif
 
   SCM value = SCM_EOL;
diff --git a/lily/program-option-scheme.cc b/lily/program-option-scheme.cc
index 1efcc75a29..2e92fcd45b 100644
--- a/lily/program-option-scheme.cc
+++ b/lily/program-option-scheme.cc
@@ -20,6 +20,7 @@ using namespace std;
 #include "warn.hh"
 
 bool debug_skylines;
+bool debug_property_callbacks;
 
 /*
   Backwards compatibility.
@@ -88,6 +89,11 @@ void internal_set_option (SCM var, SCM val)
       debug_skylines = to_boolean (val);
       val = scm_from_bool (to_boolean (val));
     }
+  else if (var == ly_symbol2scm ("debug-property-callbacks"))
+    {
+      debug_property_callbacks = to_boolean (val);
+      val = scm_from_bool (to_boolean (val));
+    }
 }
 
 
diff --git a/scm/lily.scm b/scm/lily.scm
index 94760bb5a8..5a8a744074 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -36,6 +36,7 @@
 ensure that all refs to parsed objects are dead.  This is an internal option, and is switched on automatically for -ddebug-gc.") 
     (debug-lexer #f "debug the flex lexer")
     (debug-parser #f "debug the bison parser")
+    (debug-property-callbacks #f "debug cyclic callback chains")
     (debug-skylines #f "debug skylines")
     (delete-intermediate-files #f
 			       "delete unusable PostScript files")