[test] use compile-syntax, thanks Leif

This commit is contained in:
ben 2015-12-13 22:13:34 -05:00
parent 8777de17b8
commit 705e06ff38
2 changed files with 49 additions and 69 deletions

View File

@ -2,31 +2,27 @@
;; `format:` expressions that should fail to compile
;; TODO abstract the 'module ...'
(define TEST-CASE* (syntax->list #'(
(module t typed/racket/base (require trivial/format)
(printf: "hello ~a" "john" "doe"))
(module t typed/racket/base (require trivial/format)
(printf: "hello ~a" "john" "doe"))
(module t typed/racket/base (require trivial/format)
(printf: "binary number ~b\n" 3.14))
(module t typed/racket/base (require trivial/format)
(printf: "character ~c\n" 88))
(module t typed/racket/base (require trivial/format)
(printf: "octl ~o\n" 1.0+2i))
(module t typed/racket/base (require trivial/format)
(printf: "hex ~o\n" (exact->inexact 0)))
(define (expr->typed-module expr)
#`(module t typed/racket/base
(require trivial/format)
#,expr))
(define TEST-CASE* (map expr->typed-module '(
(printf: "hello ~a" "john" "doe")
(printf: "hello ~a" "john" "doe")
(printf: "binary number ~b\n" 3.14)
(printf: "character ~c\n" 88)
(printf: "octl ~o\n" 1.0+2i)
(printf: "hex ~o\n" (exact->inexact 0))
)))
(module+ test
(require
rackunit)
(define format-eval
(let ([format-ns (make-base-namespace)])
(lambda (stx)
(lambda () ;; For `check-exn`
(eval-syntax stx format-ns)))))
(define (format-eval stx)
(lambda () ;; For `check-exn`
(compile-syntax stx)))
(for ([rkt (in-list TEST-CASE*)])
(check-exn #rx"format::|Type Checker"

View File

@ -2,63 +2,47 @@
;; TODO why can't I catch errors for (ann ... (List String))? WhydoI need #f?
(define TEST-CASE* (syntax->list #'(
(module t typed/racket/base (require trivial/regexp)
(ann
(regexp-match: "hi" "hi")
(U #f (List String String String))))
(module t typed/racket/base (require trivial/regexp)
(ann
(regexp-match: #rx"(h)(i)" "hi")
(U #f (List String))))
(module t typed/racket/base (require trivial/regexp)
(ann
(regexp-match: #px"(?<=h)(?=i)" "hi")
(U #f (List String String String))))
(module t typed/racket/base (require trivial/regexp)
;;bg; ill-typed in untyped Racket
(byte-regexp: #rx#"yolo"))
(module t typed/racket/base (require trivial/regexp)
(ann
(regexp-match: #rx#"hi" "hi")
(U #f (List String String))))
(module t typed/racket/base (require trivial/regexp)
(ann
(regexp-match: #px#"hi" "hi")
(U #f (List Bytes Bytes))))
(module t typed/racket/base (require trivial/regexp)
(ann
(regexp-match: (regexp "he") "hellooo")
(U #f (List String))))
(module t typed/racket/base (require trivial/regexp)
(ann
(let ()
(define-regexp: rx (regexp "he(l*)(o*)"))
(regexp-match: rx "hellooo"))
(U #f (List String String String))))
(module t typed/racket/base (require trivial/regexp)
;; `define` doesn't propagate group information
(ann
(let ()
(define rx "he(l*)(o*)")
(regexp-match: rx "helloooooooo"))
(U #f (List String String String))))
(define (expr->typed-module expr)
#`(module t typed/racket/base
(require trivial/regexp)
#,expr))
(define TEST-CASE* (map expr->typed-module '(
(ann (regexp-match: "hi" "hi")
(U #f (List String String String)))
(ann (regexp-match: #rx"(h)(i)" "hi")
(U #f (List String)))
(ann (regexp-match: #px"(?<=h)(?=i)" "hi")
(U #f (List String String String)))
;;bg; ill-typed in untyped Racket
(byte-regexp: #rx#"yolo")
(ann (regexp-match: #rx#"hi" "hi")
(U #f (List String String)))
(ann (regexp-match: #px#"hi" "hi")
(U #f (List Bytes Bytes)))
(ann (regexp-match: (regexp "he") "hellooo")
(U #f (List String)))
(ann (let ()
(define-regexp: rx (regexp "he(l*)(o*)"))
(regexp-match: rx "hellooo"))
(U #f (List String String String)))
;; `define` doesn't propagate group information
(ann (let ()
(define rx "he(l*)(o*)")
(regexp-match: rx "helloooooooo"))
(U #f (List String String String)))
;; --- Can't handle |, yet
(module t typed/racket/base (require trivial/regexp)
(ann
(regexp-match: "this(group)|that" "that")
(U #f (List String String))))
(ann (regexp-match: "this(group)|that" "that")
(U #f (List String String)))
)))
(module+ test
(require
rackunit)
(define regexp-eval
(let ([regexp-ns (make-base-namespace)])
(lambda (stx)
(lambda () ;; For `check-exn`
(eval-syntax stx regexp-ns)))))
(define (regexp-eval stx)
(lambda () ;; For `check-exn`
(compile-syntax stx)))
(for ([rkt (in-list TEST-CASE*)])
(check-exn #rx"Type Checker"