diff --git a/syndicate/test/pattern-test.rkt b/syndicate/test/pattern-test.rkt index 808888f..93591a7 100644 --- a/syndicate/test/pattern-test.rkt +++ b/syndicate/test/pattern-test.rkt @@ -1,18 +1,20 @@ -#lang racket/base +#lang racket (module+ test (require rackunit) (require (for-syntax racket/base)) - (require (for-syntax "pattern.rkt")) - (require "pattern.rkt") + (require (for-syntax syntax/srcloc)) + (require (for-template "../pattern.rkt")) + (require "../pattern.rkt") (struct foo (bar zot) #:prefab) (define-syntax (check-analyse-pattern stx) (syntax-case stx () [(_ expected-pat actual-stxpat fn) - #`(check-match (fn '#,(analyse-pattern #'actual-stxpat)) expected-pat)] + #`(with-check-info [('real-location #,(source-location->string stx))] + (check-match (fn '#,(analyse-pattern #'actual-stxpat)) expected-pat))] [(_ expected-pat actual-stxpat) #'(check-analyse-pattern expected-pat actual-stxpat values)])) @@ -33,18 +35,20 @@ (check-analyse-pattern '() $cap desc->skeleton-proj) (check-analyse-pattern '((0)) $cap desc->capture-proj) (check-analyse-pattern '#f $cap (s->d desc->skeleton-stx)) - (check-analyse-pattern '? $cap (s->d desc->assertion-stx)) + (check-analyse-pattern '(capture (discard)) $cap (s->d desc->assertion-stx)) (check-analyse-pattern '(123) (foo 123 $cap) desc->key) (check-analyse-pattern '((0 0)) (foo 123 $cap) desc->skeleton-proj) (check-analyse-pattern '((0 1)) (foo 123 $cap) desc->capture-proj) - (check-analyse-pattern '(list foo? #f #f) (foo 123 $cap) (s->d desc->skeleton-stx)) - (check-analyse-pattern '(foo 123 ?) (foo 123 $cap) (s->d desc->assertion-stx)) + (check-analyse-pattern '(list struct:foo #f #f) (foo 123 $cap) (s->d desc->skeleton-stx)) + (check-analyse-pattern '(foo 123 (capture (discard))) (foo 123 $cap) (s->d desc->assertion-stx)) (check-analyse-pattern '((bar 'beep)) (foo (bar 'beep) $cap) desc->key) (check-analyse-pattern '((0 0)) (foo (bar 'beep) $cap) desc->skeleton-proj) (check-analyse-pattern '((0 1)) (foo (bar 'beep) $cap) desc->capture-proj) - (check-analyse-pattern '(list foo? #f #f) (foo (bar 'beep) $cap) (s->d desc->skeleton-stx)) - (check-analyse-pattern '(foo (bar 'beep) ?) (foo (bar 'beep) $cap) (s->d desc->assertion-stx)) + (check-analyse-pattern '(list struct:foo #f #f) (foo (bar 'beep) $cap) (s->d desc->skeleton-stx)) + (check-analyse-pattern '(foo (bar 'beep) (capture (discard))) + (foo (bar 'beep) $cap) + (s->d desc->assertion-stx)) )