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

Closes FB case 188 Cleanup assumption tests in subtemplate

Browse Source
This commit is contained in:
Georges Dupéron 2017-01-26 17:14:11 +01:00
parent 3a927549e0
commit 961d507fa9
3 changed files with 112 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
test/assumption-free-identifier-equal.rkt
View File

@ -1,20 +1,25 @@
#lang racket #lang racket
(require rackunit)
(define-for-syntax outer #f) (define-for-syntax outer #f)
(define-for-syntax inner #f) (define-for-syntax inner #f)
(let ([x 1])
(define-syntax (capture1 stx) (check-equal? (let ([x 1])
(set! outer #'x) (define-syntax (capture1 stx)
#'(void)) (set! outer #'x)
(capture1) #'(void))
(let ([x 2]) (capture1)
(define-syntax (capture2 stx) (let ([x 2])
(set! inner #'x) (define-syntax (capture2 stx)
#'(void)) (set! inner #'x)
(capture2) #'(void))
(let ([y 3]) (capture2)
(define-syntax (compare stx) (let ([y 3])
(define candidate (datum->syntax #'y 'x)) (define-syntax (compare stx)
#;(displayln (free-identifier=? candidate inner)) (define candidate (datum->syntax #'y 'x))
#;(displayln (free-identifier=? candidate outer)) ;; check that (datum->syntax #'y 'x) matches the
#'(void)) ;; inner x, but not the outer x, since they are already
(compare)))) ;; bound when the macro is executed.
#`(list #,(free-identifier=? candidate inner)
#,(free-identifier=? candidate outer)))
(compare))))
'(#t #f))

103
test/assumption-weak-hash.rkt
View File

@ -1,6 +1,7 @@
#lang racket #lang racket
(require (for-syntax racket/private/sc)) (require (for-syntax racket/private/sc)
rackunit)
(define h (make-weak-hasheq)) (define h (make-weak-hasheq))
@ -10,15 +11,91 @@
(car l) (car l)
(cdr l))) (cdr l)))
(for/list ([range-a (in-range 100)]) ;; The data stored in the valvar is unique fore each use of (datum->syntax …)
(with-syntax ([(xᵢ ...) #'(1 2 3)]) (check-false
(define-syntax (hh stx) (check-duplicates
#`(hash-ref! h (for/list ([range-a (in-range 5)])
#,(syntax-mapping-valvar (syntax-local-value #'xᵢ)) (with-syntax ([(xᵢ ...) (datum->syntax #'here '(1 2 3))])
(gensym))) (define-syntax (hh stx)
(displayln (hash->list h)) #`(hash-ref! h
(all-eq? (for/list ([range-b (in-range 5)]) #,(syntax-mapping-valvar
(collect-garbage) (syntax-local-value #'xᵢ))
;(collect-garbage) (gensym)))
;(collect-garbage) (all-eq? (for/list ([range-b (in-range 5)])
(hh))))) (collect-garbage)
(collect-garbage)
(collect-garbage)
(hh)))))))
;; but not if the syntax object is a constant, e.g. #'(1 2 3)
(check-pred all-eq?
(for/list ([range-a (in-range 5)])
(with-syntax ([(xᵢ ...) #'(1 2 3)]) ;; CHANGED THIS LINE
(define-syntax (hh stx)
#`(hash-ref! h
#,(syntax-mapping-valvar
(syntax-local-value #'xᵢ))
(gensym)))
(all-eq? (for/list ([range-b (in-range 5)])
(collect-garbage)
(collect-garbage)
(collect-garbage)
(hh))))))
;; nor it the same syntax object is reuqes
(define stxobj (datum->syntax #'here '(1 2 3))) ;; cached stxobj here
(check-pred all-eq?
(for/list ([range-a (in-range 5)])
(with-syntax ([(xᵢ ...) stxobj]) ;; CHANGED THIS LINE
(define-syntax (hh stx)
#`(hash-ref! h
#,(syntax-mapping-valvar
(syntax-local-value #'xᵢ))
(gensym)))
(all-eq? (for/list ([range-b (in-range 5)])
(collect-garbage)
(collect-garbage)
(collect-garbage)
(hh))))))
;; Another example showing this behaviour:
;; The contents of the valvar is eq? when using a literal syntax object like:
;; #'(1 2 3)
;; but not with:
;; (datum->syntax #'here '(1 2 3))
;; I expected the result to always be different at each execution of the
;; with-syntax, but it turns out the syntax object is kept as-is.
(begin
(let ()
(define old1 #f)
(check-true
(andmap identity
(for/list ([range-a (in-range 100)])
;; #'(1 2 3) HERE:
(with-syntax ([(xᵢ ...) #'(1 2 3)])
(define-syntax (hh stx)
#`#,(syntax-mapping-valvar (syntax-local-value #'xᵢ)))
(unless old1
;; Initial set!
(set! old1 (hh)))
(andmap identity (for/list ([range-b (in-range 5)])
(eq? old1 hh))))))))
(let ()
(define old2 #f)
(check-equal?
(let ([res (for/list ([range-a (in-range 100)])
;; CHANGED THIS:
(with-syntax ([(xᵢ ...) (datum->syntax #'here '(1 2 3))])
(define-syntax (hh stx)
#`#,(syntax-mapping-valvar (syntax-local-value #'xᵢ)))
(unless old2
;; Initial set!
(set! old2 (hh)))
(andmap identity (for/list ([range-b (in-range 5)])
(eq? old2 hh)))))])
(list (car res) (ormap identity (cdr res))))
'(#t #f))))

18
test/wrong-assumption-with-syntax-eq.rkt
View File

@ -1,18 +0,0 @@
#lang racket
(require (for-syntax racket/private/sc))
(define old #f)
(for/list ([range-a (in-range 100)])
;; The contents of the valvar is eq? when using a literal syntax object
;; #'(1 2 3), but not with (datum->syntax #'here '(1 2 3)).
;; I expected the result to always be different at each execution of the
;; with-syntax, but it turns out the syntax object is kept as-is.
(with-syntax ([(xᵢ ...) #'(1 2 3) #;(datum->syntax #'here '(1 2 3))])
(define-syntax (hh stx)
#`#,(syntax-mapping-valvar (syntax-local-value #'xᵢ)))
(unless old
(displayln "initial set!")
(set! old (hh)))
(andmap identity (for/list ([range-b (in-range 5)])
(eq? old hh)))))