syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Repair rotten pattern tests

This commit is contained in:
Tony Garnock-Jones 2018-04-29 11:30:26 +01:00
parent 3a857db4b9
commit afad4cd0be
1 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
syndicate/test/pattern-test.rkt
View File

@ -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))
)