[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 ;; `format:` expressions that should fail to compile
;; TODO abstract the 'module ...' (define (expr->typed-module expr)
(define TEST-CASE* (syntax->list #'( #`(module t typed/racket/base
(module t typed/racket/base (require trivial/format) (require trivial/format)
(printf: "hello ~a" "john" "doe")) #,expr))
(module t typed/racket/base (require trivial/format)
(printf: "hello ~a" "john" "doe")) (define TEST-CASE* (map expr->typed-module '(
(module t typed/racket/base (require trivial/format) (printf: "hello ~a" "john" "doe")
(printf: "binary number ~b\n" 3.14)) (printf: "hello ~a" "john" "doe")
(module t typed/racket/base (require trivial/format) (printf: "binary number ~b\n" 3.14)
(printf: "character ~c\n" 88)) (printf: "character ~c\n" 88)
(module t typed/racket/base (require trivial/format) (printf: "octl ~o\n" 1.0+2i)
(printf: "octl ~o\n" 1.0+2i)) (printf: "hex ~o\n" (exact->inexact 0))
(module t typed/racket/base (require trivial/format)
(printf: "hex ~o\n" (exact->inexact 0)))
))) )))
(module+ test (module+ test
(require (require
rackunit) rackunit)
(define format-eval (define (format-eval stx)
(let ([format-ns (make-base-namespace)])
(lambda (stx)
(lambda () ;; For `check-exn` (lambda () ;; For `check-exn`
(eval-syntax stx format-ns))))) (compile-syntax stx)))
(for ([rkt (in-list TEST-CASE*)]) (for ([rkt (in-list TEST-CASE*)])
(check-exn #rx"format::|Type Checker" (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? ;; TODO why can't I catch errors for (ann ... (List String))? WhydoI need #f?
(define TEST-CASE* (syntax->list #'( (define (expr->typed-module expr)
(module t typed/racket/base (require trivial/regexp) #`(module t typed/racket/base
(ann (require trivial/regexp)
(regexp-match: "hi" "hi") #,expr))
(U #f (List String String String))))
(module t typed/racket/base (require trivial/regexp) (define TEST-CASE* (map expr->typed-module '(
(ann (ann (regexp-match: "hi" "hi")
(regexp-match: #rx"(h)(i)" "hi") (U #f (List String String String)))
(U #f (List String)))) (ann (regexp-match: #rx"(h)(i)" "hi")
(module t typed/racket/base (require trivial/regexp) (U #f (List String)))
(ann (ann (regexp-match: #px"(?<=h)(?=i)" "hi")
(regexp-match: #px"(?<=h)(?=i)" "hi") (U #f (List String String String)))
(U #f (List String String String))))
(module t typed/racket/base (require trivial/regexp)
;;bg; ill-typed in untyped Racket ;;bg; ill-typed in untyped Racket
(byte-regexp: #rx#"yolo")) (byte-regexp: #rx#"yolo")
(module t typed/racket/base (require trivial/regexp) (ann (regexp-match: #rx#"hi" "hi")
(ann (U #f (List String String)))
(regexp-match: #rx#"hi" "hi") (ann (regexp-match: #px#"hi" "hi")
(U #f (List String String)))) (U #f (List Bytes Bytes)))
(module t typed/racket/base (require trivial/regexp) (ann (regexp-match: (regexp "he") "hellooo")
(ann (U #f (List String)))
(regexp-match: #px#"hi" "hi") (ann (let ()
(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*)")) (define-regexp: rx (regexp "he(l*)(o*)"))
(regexp-match: rx "hellooo")) (regexp-match: rx "hellooo"))
(U #f (List String String String)))) (U #f (List String String String)))
(module t typed/racket/base (require trivial/regexp)
;; `define` doesn't propagate group information ;; `define` doesn't propagate group information
(ann (ann (let ()
(let ()
(define rx "he(l*)(o*)") (define rx "he(l*)(o*)")
(regexp-match: rx "helloooooooo")) (regexp-match: rx "helloooooooo"))
(U #f (List String String String)))) (U #f (List String String String)))
;; --- Can't handle |, yet ;; --- Can't handle |, yet
(module t typed/racket/base (require trivial/regexp) (ann (regexp-match: "this(group)|that" "that")
(ann (U #f (List String String)))
(regexp-match: "this(group)|that" "that")
(U #f (List String String))))
))) )))
(module+ test (module+ test
(require (require
rackunit) rackunit)
(define regexp-eval (define (regexp-eval stx)
(let ([regexp-ns (make-base-namespace)])
(lambda (stx)
(lambda () ;; For `check-exn` (lambda () ;; For `check-exn`
(eval-syntax stx regexp-ns))))) (compile-syntax stx)))
(for ([rkt (in-list TEST-CASE*)]) (for ([rkt (in-list TEST-CASE*)])
(check-exn #rx"Type Checker" (check-exn #rx"Type Checker"