From 7a01250dbac8af53fe7bb7be5f429df1b38e2afd Mon Sep 17 00:00:00 2001
From: ben <types@ccs.neu.edu>
Date: Sat, 12 Dec 2015 22:22:35 -0500
Subject: [PATCH] [format] pass / fail tests

---
 test/format/fail.rkt | 34 +++++++++++++++++++++++
 test/format/pass.rkt | 66 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 100 insertions(+)
 create mode 100644 test/format/fail.rkt
 create mode 100644 test/format/pass.rkt

diff --git a/test/format/fail.rkt b/test/format/fail.rkt
new file mode 100644
index 0000000..051287b
--- /dev/null
+++ b/test/format/fail.rkt
@@ -0,0 +1,34 @@
+#lang racket/base
+
+;; `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)))
+)))
+
+(module+ test
+  (require
+    rackunit)
+
+  (define format-eval
+    (let ([format-ns (make-base-namespace)])
+      (lambda (stx)
+        (lambda () ;; For `check-exn`
+          (eval-syntax stx format-ns)))))
+
+  (for ([rkt (in-list TEST-CASE*)])
+    (check-exn #rx"format::|Type Checker"
+      (format-eval rkt)))
+)
diff --git a/test/format/pass.rkt b/test/format/pass.rkt
new file mode 100644
index 0000000..c9b2dc2
--- /dev/null
+++ b/test/format/pass.rkt
@@ -0,0 +1,66 @@
+#lang typed/racket/base
+
+(require trivial/format)
+
+(module+ test
+  (printf "Testing statically-checked formatting:\n~a\n"
+    (make-string 10 #\=))
+
+  (define-syntax-rule (test-case doc template arg* ...)
+    (begin
+      (display "TEST ")
+      (displayln doc)
+      (display "  [printf] ")
+      (printf: template arg* ...)
+      (newline)
+      (display "  [format] ")
+      (display (format: template arg* ...))
+      (newline)
+      (newline)))
+
+  (define H "hello")
+
+  (test-case "without arguments"
+    "success")
+  (test-case "one '~a' arg"
+    "~a" H)
+  (test-case "one '~A' arg"
+    "~A" H)
+  (test-case "one '~b' arg"
+    "~b" 9)
+  (test-case "one '~B' arg"
+    "~B" 9)
+  (test-case "one '~c' arg"
+    "~c" #\Y)
+  (test-case "one '~C' arg"
+    "~C" #\Y)
+  (test-case "one '~e' arg"
+    "~e" H)
+  (test-case "one '~E' arg"
+    "~E" H)
+  (test-case "one '~o' arg"
+    "~o" 9)
+  (test-case "one '~O' arg"
+    "~O" 9)
+  (test-case "one '~s' arg"
+    "~s" H)
+  (test-case "one '~S' arg"
+    "~S" H)
+  (test-case "one '~v' arg"
+    "~v" H)
+  (test-case "one '~V' arg"
+    "~V" H)
+  (test-case "one '~x' arg"
+    "~x" 12)
+  (test-case "one '~X' arg"
+    "~X" 12)
+  (test-case "~<whitespace>"
+    "hello ~        \n   world")
+
+  (parameterize ([error-print-width 4])
+    (test-case "two 'display' args, second truncated"
+      "arg1 = ~a, arg2 = ~.a" "hello" "world"))
+
+  (test-case "string with newline"
+    "begin... ~n                ...end")
+)