Ticket #1336: 0001-Save-current-values-when-leaving-parameterizes.patch

File 0001-Save-current-values-when-leaving-parameterizes.patch, 3.2 KB (added by sjamaan, 2 years ago)

First attempt, not working properly in compiled mode yet

  • NEWS

    From 0d19c7ac952b3c70fdc47b1b829f4c668b2ebf4a Mon Sep 17 00:00:00 2001
    From: Peter Bex <peter@more-magic.net>
    Date: Tue, 6 Dec 2016 22:12:59 +0100
    Subject: [PATCH] Save "current" values when leaving parameterizes.
    
    These remembered parameter values are reinstated when we enter the
    dynamic extent again, instead of resetting to the original values the
    parameters had when first entering the extent, like we did in the fix
    for #1227.
    ---
     NEWS                    |  4 ++++
     chicken-syntax.scm      | 11 ++++++++---
     tests/library-tests.scm | 35 +++++++++++++++++++++++++++++++++++
     3 files changed, 47 insertions(+), 3 deletions(-)
    
    diff --git a/NEWS b/NEWS
    index d3c9b40..052cf13 100644
    a b  
    99
    1010- Core libraries:
    1111  - Keywords are more consistently read/written, like symbols (#1332).
     12  - SRFI-39: When jumping out of a parameterized dynamic extent,
     13    "parameterize" now remember the actual values, so when jumping back
     14    in, they are restored (fixes #1336, thanks to Joo ChurlSoo).
     15    This was a regression caused by the fix for #1227.
    1216
    13174.11.1
    1418
  • chicken-syntax.scm

    diff --git a/chicken-syntax.scm b/chicken-syntax.scm
    index ec9aff3..364dad2 100644
    a b  
    309309             (##core#set! ,convert? #f) ) )
    310310           (##core#lambda () ,@body)
    311311           (##core#lambda ()
    312             ;; Restore parameters to their original, saved values
    313             ,@(map (lambda (p s) `(,p ,s #f #t))
    314                    param-aliases saveds) )) ) ) ) ) )))
     312             ;; Swap parameters with their original, saved values.
     313             ,@(map (lambda (p s t)
     314                      `(##core#let ((,t (,p)))
     315                         ;; Restore to old value.
     316                         (,p ,s #f #t)
     317                         ;; Save current value for later re-invocations.
     318                         (##core#set! ,s ,t)))
     319                    param-aliases saveds temps) )) ) ) ) ) )))
    315320
    316321(##sys#extend-macro-environment
    317322 'when '()
  • tests/library-tests.scm

    diff --git a/tests/library-tests.scm b/tests/library-tests.scm
    index 384ca40..cd2f6e9 100644
    a b A 
    587587  (assert (equal? original-error (current-error-port)))
    588588  (assert (equal? original-exception-handler (current-exception-handler))))
    589589
     590;; Re-entering dynamic extent of a parameterize should not reset to
     591;; original outer values but remember values when jumping out (another
     592;; regression due to #1227, pointed out by Joo ChurlSoo in #1336).
     593
     594(let ((f (make-parameter 'a))
     595      (path '())
     596      (g (make-parameter 'g))
     597      (c #f))
     598  (let ((add (lambda () (set! path (cons (f) path)))))
     599    (add)
     600    (parameterize ((f 'b)
     601                   (g (call-with-current-continuation
     602                       (lambda (c0) (set! c c0) 'c))))
     603      (add) (f (g)) (add))
     604    (f 'd)
     605    (add)
     606    (if (< (length path) 8)
     607        (c 'e)
     608        (assert (equal? '(a b c d b e d b e d) (reverse path))))))
     609
     610(let ((f (make-parameter 'a))
     611      (path '())
     612      (g (make-parameter 'g))
     613      (c #f))
     614  (let ((add (lambda () (set! path (cons (f) path)))))
     615    (add)
     616    (parameterize ((f 'b))
     617      (g (call-with-current-continuation (lambda (c0) (set! c c0) 'c)))
     618      (add) (f (g)) (add))
     619    (f 'd)
     620    (add)
     621    (if (< (length path) 8)
     622        (c 'e)
     623        (assert (equal? '(a b c d c e d e e d) (reverse path))))))
     624
    590625;;; vector and blob limits
    591626
    592627(assert-fail (make-blob -1))