~ chicken-core (chicken-5) f757e7d9977663f663840dc86e4028e1d36a844b

commit f757e7d9977663f663840dc86e4028e1d36a844b
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Feb 16 14:35:20 2016 +1300
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Tue Feb 16 14:35:20 2016 +1300

    Allow multiple debug modes to be used for `debugging`
    
    Previously, `with-debugging-output` allowed using a list to specify
    multiple debug modes, but `debugging` didn't. The scrutinizer uses
    "(debugging '(o e) ...)" to print specialization info, however, meaning
    that info was never printed. This change just makes both procedures
    accept a list of modes.

diff --git a/support.scm b/support.scm
index 63c7fc75..89538b6a 100644
--- a/support.scm
+++ b/support.scm
@@ -107,6 +107,11 @@
 
 (define +logged-debugging-modes+ '(o x S))
 
+(define (test-debugging-mode mode enabled)
+  (if (symbol? mode)
+      (memq mode enabled)
+      (any (lambda (m) (memq m enabled)) mode)))
+
 (define (debugging mode msg . args)
   (define (text)
     (with-output-to-string
@@ -120,15 +125,15 @@
 	(newline))))
   (define (dump txt)
     (fprintf collected-debugging-output "~a|~a" mode txt))
-  (cond ((memq mode debugging-chicken)
+  (cond ((test-debugging-mode mode debugging-chicken)
 	 (let ((txt (text)))
 	   (display txt)
 	   (flush-output)
-	   (when (memq mode +logged-debugging-modes+)
+	   (when (test-debugging-mode mode +logged-debugging-modes+)
 	     (dump txt))
 	   #t))
 	(else
-	 (when (memq mode +logged-debugging-modes+)
+	 (when (test-debugging-mode mode +logged-debugging-modes+)
 	   (dump (text)))
 	 #f)))
 
@@ -140,17 +145,13 @@
 	 (if (pair? mode) (car mode) mode)
 	 ln))
      (string-split text "\n")))
-  (define (test-mode mode set)
-    (if (symbol? mode)
-	(memq mode set)
-	(pair? (lset-intersection/eq? mode set))))
-  (cond ((test-mode mode debugging-chicken)
+  (cond ((test-debugging-mode mode debugging-chicken)
 	 (let ((txt (with-output-to-string thunk)))
 	   (display txt)
 	   (flush-output)
-	   (when (test-mode mode +logged-debugging-modes+)
+	   (when (test-debugging-mode mode +logged-debugging-modes+)
 	     (collect txt))))
-	((test-mode mode +logged-debugging-modes+)
+	((test-debugging-mode mode +logged-debugging-modes+)
 	 (collect (with-output-to-string thunk)))))
 
 (define (quit-compiling msg . args)