From b534242051a22e861fa83a672682ed0c53f94363 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sun, 29 Jun 2014 15:52:57 -0700
Subject: [PATCH] Add tests for generated syntax of static contracts.

original commit: decc3c63761bc044f2e9f33dfd7a0b5c2599126c
---
 .../static-contract-optimizer-tests.rkt       | 41 ++++++++++++++++++-
 1 file changed, 39 insertions(+), 2 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
index c84a9459..608d889a 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
@@ -37,12 +37,44 @@
             (unless (equal? opt expected)
               (fail-check))))))))
 
+(define-syntax (check-syntax stx)
+  (syntax-parse stx
+    [(_ argument* expected*)
+     #'(test-case (~a 'argument*)
+         (define argument argument*)
+         (define expected expected*)
+         (with-check-info*
+           (list (make-check-info 'original argument)
+                 (make-check-expected expected))
+           (λ ()
+             (let ([ctc (syntax->datum
+                          (instantiate
+                            (optimize argument #:trusted-positive #t)
+                            (λ (#:reason [reason #f]) (error 'nyi))
+                            'impersonator))])
+               (with-check-info* (list (make-check-actual ctc))
+                 (λ ()
+                   (unless (equal? ctc expected)
+                     (fail-check))))))))]))
+
 ;; Ids with unique identity so that equals works
 (define foo-id #'foo)
 (define bar-id #'bar)
 
-(define tests
-  (test-suite "Static Contract Optimizer Tests"
+(define syntax-tests
+  (test-suite "Optimized Syntax Tests"
+    (check-syntax list?/sc
+      'any/c)
+    (check-syntax (arr/sc null #f (list list?/sc))
+      '(-> any))
+    (check-syntax (hash/sc list?/sc list?/sc)
+      '(hash/c list? list?))
+
+    ))
+
+
+(define optimizer-tests
+  (test-suite "Optimizer Tests"
     ;; Lists
     (check-optimize (listof/sc any/sc)
       #:pos any/sc
@@ -292,3 +324,8 @@
                 (arr/sc (list any/sc) #f (list (listof/sc set?/sc))))))
 
     ))
+
+(define tests
+  (test-suite "Static Contracts"
+    syntax-tests
+    optimizer-tests))