commit 961d507fa9171362bced8e3f14f3e0fba99f7792
parent 3a927549e08f3e51934b04e51e9b3aa6f20765fd
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Thu, 26 Jan 2017 17:14:11 +0100
Closes FB case 188 Cleanup assumption tests in subtemplate
Diffstat:
3 files changed, 114 insertions(+), 51 deletions(-)
diff --git 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
@@ -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
@@ -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
