From 961d507fa9171362bced8e3f14f3e0fba99f7792 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Thu, 26 Jan 2017 17:14:11 +0100 Subject: [PATCH] Closes FB case 188 Cleanup assumption tests in subtemplate --- test/assumption-free-identifier-equal.rkt | 39 ++++---- test/assumption-weak-hash.rkt | 103 +++++++++++++++++++--- test/wrong-assumption-with-syntax-eq.rkt | 18 ---- 3 files changed, 112 insertions(+), 48 deletions(-) delete mode 100644 test/wrong-assumption-with-syntax-eq.rkt diff --git a/test/assumption-free-identifier-equal.rkt b/test/assumption-free-identifier-equal.rkt index a754415..7696925 100644 --- a/test/assumption-free-identifier-equal.rkt +++ b/test/assumption-free-identifier-equal.rkt @@ -1,20 +1,25 @@ #lang racket +(require rackunit) (define-for-syntax outer #f) (define-for-syntax inner #f) -(let ([x 1]) - (define-syntax (capture1 stx) - (set! outer #'x) - #'(void)) - (capture1) - (let ([x 2]) - (define-syntax (capture2 stx) - (set! inner #'x) - #'(void)) - (capture2) - (let ([y 3]) - (define-syntax (compare stx) - (define candidate (datum->syntax #'y 'x)) - #;(displayln (free-identifier=? candidate inner)) - #;(displayln (free-identifier=? candidate outer)) - #'(void)) - (compare)))) \ No newline at end of file + +(check-equal? (let ([x 1]) + (define-syntax (capture1 stx) + (set! outer #'x) + #'(void)) + (capture1) + (let ([x 2]) + (define-syntax (capture2 stx) + (set! inner #'x) + #'(void)) + (capture2) + (let ([y 3]) + (define-syntax (compare stx) + (define candidate (datum->syntax #'y 'x)) + ;; check that (datum->syntax #'y 'x) matches the + ;; inner x, but not the outer x, since they are already + ;; bound when the macro is executed. + #`(list #,(free-identifier=? candidate inner) + #,(free-identifier=? candidate outer))) + (compare)))) + '(#t #f)) \ No newline at end of file diff --git a/test/assumption-weak-hash.rkt b/test/assumption-weak-hash.rkt index 15ef939..06a57bb 100644 --- a/test/assumption-weak-hash.rkt +++ b/test/assumption-weak-hash.rkt @@ -1,6 +1,7 @@ #lang racket -(require (for-syntax racket/private/sc)) +(require (for-syntax racket/private/sc) + rackunit) (define h (make-weak-hasheq)) @@ -10,15 +11,91 @@ (car l) (cdr l))) -(for/list ([range-a (in-range 100)]) - (with-syntax ([(xᵢ ...) #'(1 2 3)]) - (define-syntax (hh stx) - #`(hash-ref! h - #,(syntax-mapping-valvar (syntax-local-value #'xᵢ)) - (gensym))) - (displayln (hash->list h)) - (all-eq? (for/list ([range-b (in-range 5)]) - (collect-garbage) - ;(collect-garbage) - ;(collect-garbage) - (hh))))) \ No newline at end of file +;; The data stored in the valvar is unique fore each use of (datum->syntax …) +(check-false + (check-duplicates + (for/list ([range-a (in-range 5)]) + (with-syntax ([(xᵢ ...) (datum->syntax #'here '(1 2 3))]) + (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))))))) + +;; 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)))) \ No newline at end of file diff --git a/test/wrong-assumption-with-syntax-eq.rkt b/test/wrong-assumption-with-syntax-eq.rkt deleted file mode 100644 index 85d4798..0000000 --- a/test/wrong-assumption-with-syntax-eq.rkt +++ /dev/null @@ -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))))) \ No newline at end of file