suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixes #1497 free-id-table-ref! with procedure failure argument stores the procedure, not its result

Browse Source
This commit is contained in:
Georges Dupéron 2016-10-28 04:01:22 +02:00
parent 432afc4561
commit 4ed74b5226
2 changed files with 23 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
pkgs/racket-test-core/tests/racket/id-table-test.rktl
View File

@ -397,11 +397,19 @@
(define x1 ((make-syntax-introducer) x0))
(define y0 #'y)
(define y1 ((make-syntax-introducer) y0))
(define z0 #'z)
(define z1 ((make-syntax-introducer) z0))
(test 0 bound-id-table-ref! table x0 0)
(test 1 bound-id-table-ref! table x1 1)
(test 0 bound-id-table-ref! table x0 (lambda () 0))
(test 1 bound-id-table-ref! table x1 (lambda () 1))
;; Check that the lambda is immediately called
(begin
(test 0 bound-id-table-ref! table z0 (lambda () 0))
(test 1 bound-id-table-ref! table z1 (lambda () 1)))
;; Check that the result of the call was inserted
(begin
(test 0 bound-id-table-ref table z0)
(test 1 bound-id-table-ref table z1))
(test 0 bound-id-table-ref table x0)
(test 1 bound-id-table-ref (bound-id-table-update table2 y0 add1 0) y0)
(test 1 bound-id-table-ref (bound-id-table-set* table2 y0 0 y1 1) y1)
@ -416,11 +424,19 @@
(define x1 #'x1)
(define y0 #'y)
(define y1 #'y1)
(define z0 #'z)
(define z1 #'z1)
(test 0 free-id-table-ref! table x0 0)
(test 1 free-id-table-ref! table x1 1)
(test 0 free-id-table-ref! table x0 (lambda () 0))
(test 1 free-id-table-ref! table x1 (lambda () 1))
;; Check that the lambda is immediately called
(begin
(test 0 free-id-table-ref! table z0 (lambda () 0))
(test 1 free-id-table-ref! table z1 (lambda () 1)))
;; Check that the result of the call was inserted
(begin
(test 0 free-id-table-ref table z0)
(test 1 free-id-table-ref table z1))
(test 0 free-id-table-ref table x0)
(test 1 free-id-table-ref (free-id-table-update table2 y0 add1 0) y0)
(test 1 free-id-table-ref (free-id-table-set* table2 y0 0 y1 1) y1)

5
racket/collects/syntax/private/id-table.rkt
View File

@ -160,8 +160,9 @@ The {key,value}-{in-out} functions should all return a chaperone of their argume
(define (id-table-ref! who d id default identifier->symbol identifier=?)
(define entry (id-table-ref who d id missing identifier->symbol identifier=?))
(cond [(eq? entry missing)
(id-table-set! who d id default identifier->symbol identifier=?)
(if (procedure? default) (default) default)]
(let ([called-default (if (procedure? default) (default) default)])
(id-table-set! who d id called-default identifier->symbol identifier=?)
called-default)]
[else entry]))
(define (id-table-update/constructor who d id updater default constructor identifier->symbol identifier=?)