Ticket #803: 0001-when-calling-a-possibly-mutatiing-procedure-invalid.patch

File 0001-when-calling-a-possibly-mutatiing-procedure-invalid.patch, 1.9 KB (added by felix winkelmann, 12 years ago)

patch submitted to chicken-hackers

  • scrutinizer.scm 

    From fe17c647988d8e4e3238d01f90781859cbd1dfe8 Mon Sep 17 00:00:00 2001
From: felix <felix@call-with-current-continuation.org>
Date: Sat, 21 Apr 2012 15:51:38 +0200
Subject: [PATCH] when calling a possibly mutating procedure, invalidate list-of/list types by converting them to type pair (fixes #803)

---
 scrutinizer.scm                 |   14 ++++++++++----
 tests/specialization-test-1.scm |    5 +++++
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 782cd60..3492a88 100755
    a b  
    829829      rn)))
    830830     
    831831
    832 ;;; replace pair/vector types with components to component-less variants in env or blist
     832;;; replace pair/vector types with components to variants with undetermined
     833;;  component types (used for env or blist); also convert "list[-of]" types
     834;;  into "pair", since mutation may take place
    833835
    834836(define (smash-component-types! lst where)
    835837  (do ((lst lst (cdr lst)))
    … …  
    838840               (change! (cute set-cdr! (car lst) <>)))
    839841      (when (pair? t)
    840842        (case (car t)
    841           ((list-of vector-of)
     843          ((vector-of)
    842844           (dd "  smashing `~s' in ~a" (caar lst) where)
    843            (change! (if (eq? 'list-of (car t)) 'list 'vector))
     845           (change! 'vector)
    844846           (car t))
    845           ((pair vector list)
     847          ((list-of list)
     848           (dd "  smashing `~s' in ~a" (caar lst) where)
     849           (change! 'pair)
     850           (car t))
     851          ((pair vector)
    846852           (dd "  smashing `~s' in ~a" (caar lst) where)
    847853           (change! (car t))
    848854           (car t))

  • tests/specialization-test-1.scm 

    diff --git a/tests/specialization-test-1.scm b/tests/specialization-test-1.scm
index 9d380fc..0157420 100644
    a b return n;} 
    3636
    3737(assert (= 2 (spec 1)))
    3838
     39;; "smash-component-types!" had to convert "list[-of]" types to "pair" (#803)
     40(let ((x (list 'a)))
     41  (set-cdr! x x)
     42  (assert (not (list? x))))
     43
    3944)