~ chicken-core (chicken-5) ce3eb589552465c7898271a6515512d65bb09725

commit ce3eb589552465c7898271a6515512d65bb09725
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Apr 21 15:51:38 2012 +0200
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Sat Apr 21 18:59:49 2012 +0200

    when calling a possibly mutating procedure, invalidate list-of/list types by converting them to type pair (fixes #803)
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 782cd607..3492a886 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -829,7 +829,9 @@
       rn)))
       
 
-;;; replace pair/vector types with components to component-less variants in env or blist
+;;; replace pair/vector types with components to variants with undetermined
+;;  component types (used for env or blist); also convert "list[-of]" types
+;;  into "pair", since mutation may take place
 
 (define (smash-component-types! lst where)
   (do ((lst lst (cdr lst)))
@@ -838,11 +840,15 @@
 	       (change! (cute set-cdr! (car lst) <>)))
       (when (pair? t)
 	(case (car t)
-	  ((list-of vector-of)
+	  ((vector-of)
 	   (dd "  smashing `~s' in ~a" (caar lst) where)
-	   (change! (if (eq? 'list-of (car t)) 'list 'vector))
+	   (change! 'vector)
 	   (car t))
-	  ((pair vector list)
+	  ((list-of list)
+	   (dd "  smashing `~s' in ~a" (caar lst) where)
+	   (change! 'pair)
+	   (car t))
+	  ((pair vector)
 	   (dd "  smashing `~s' in ~a" (caar lst) where)
 	   (change! (car t))
 	   (car t))
diff --git a/tests/specialization-test-1.scm b/tests/specialization-test-1.scm
index 9d380fcc..01574204 100644
--- a/tests/specialization-test-1.scm
+++ b/tests/specialization-test-1.scm
@@ -36,4 +36,9 @@ return n;}
 
 (assert (= 2 (spec 1)))
 
+;; "smash-component-types!" had to convert "list[-of]" types to "pair" (#803)
+(let ((x (list 'a)))
+  (set-cdr! x x)
+  (assert (not (list? x))))
+
 )