~ chicken-core (chicken-5) 502d50d350131aa35280dffdab337da2f5e81808

commit 502d50d350131aa35280dffdab337da2f5e81808
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Wed Oct 21 10:20:51 2020 +0300
Commit:     megane <meganeka@gmail.com>
CommitDate: Wed Dec 23 13:25:22 2020 +0200

    Fix crash when accessing block header of immediate values in pretty-printer
    
    This fixes a segmentation fault when pretty-printing C_SCHEME_UNBOUND,
    since we reach into the value with C_block_header() in C_anypointerp()
    before checking for C_unboundvaluep(). This crashes, since unbound is an
    immediate value.
    
    In addition to moving the call to C_unboundvaluep() above the call to
    C_anypointerp(), this also adds a generic check for any other immediate
    values before the remaining cases, which handle non-immediate objects.
    
    Signed-off-by: megane <meganeka@gmail.com>
    - I added a test

diff --git a/extras.scm b/extras.scm
index 76c23a21..cc679697 100644
--- a/extras.scm
+++ b/extras.scm
@@ -356,9 +356,9 @@
 					     (out (number->string code 16) col) ]
 					    [else (out (make-string 1 obj) col)] ) ) ) )
 	    ((##core#inline "C_undefinedp" obj) (out "#<unspecified>" col))
+	    ((##core#inline "C_unboundvaluep" obj) (out "#<unbound value>" col))
+	    ((##core#inline "C_immp" obj) (out "#<unprintable object>" col))
 	    ((##core#inline "C_anypointerp" obj) (out (##sys#pointer->string obj) col))
-	    ((##core#inline "C_unboundvaluep" obj)
-	     (out "#<unbound value>" col) )
 	    ((##sys#generic-structure? obj)
 	     (let ([o (open-output-string)])
 	       (##sys#user-print-hook obj #t o)
diff --git a/tests/pp-test.scm b/tests/pp-test.scm
index 02617303..84d1da17 100644
--- a/tests/pp-test.scm
+++ b/tests/pp-test.scm
@@ -1,7 +1,8 @@
 ;;;; pp-test.scm
 
 (import (only chicken.pretty-print pp)
-        (only chicken.port with-output-to-string))
+        (only chicken.port with-output-to-string)
+	(only (chicken memory representation) block-ref))
 
 (define (pp->string thing)
   (with-output-to-string (cut pp thing)))
@@ -17,3 +18,4 @@
 (test "\"\\\"\\\"\\\"\"\n" (pp->string "\"\"\""))
 (test "\"\\n\\t\\r\\b\\a\\v\\f\"\n" (pp->string "\n\t\r\b\a\v\f"))
 (test "\\" "\\")                        ; XXX?
+(test "#<unbound value>\n" (pp->string (block-ref 'aardvark 0))) ;; Shouldn't crash