From 6c224835a899674d300b1b33a99f3aa7f4182003 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 30 Mar 2016 16:05:16 -0700
Subject: [PATCH] improve tests for `sugar/define`

---
 sugar/test/main.rkt | 66 +++++++++++++++++++++++++++++++++++++++------
 1 file changed, 58 insertions(+), 8 deletions(-)

diff --git a/sugar/test/main.rkt b/sugar/test/main.rkt
index d0b19bf..d10b4b6 100644
--- a/sugar/test/main.rkt
+++ b/sugar/test/main.rkt
@@ -1,7 +1,7 @@
 #lang racket
 (require (for-syntax racket/syntax syntax/strip-context))
 
-(define-syntax (eval-as-untyped stx)
+(define-syntax (eval-with-and-without-contracts stx)
   (syntax-case stx ()
     [(_ exprs ...)
      (with-syntax ([module-without-contracts (generate-temporary)]
@@ -18,7 +18,7 @@
                             (require 'module-with-contracts))))]))
 
 
-(eval-as-untyped
+(eval-with-and-without-contracts
  (check-equal? (->int 42) 42)
  (check-equal? (->int 42.1) 42)
  (check-equal? (->int 42+3i) 42)
@@ -56,6 +56,62 @@
  (check-true (->boolean "foo"))
  (check-true (->boolean '()))
  (check-true (->boolean '(1 2 3)))
+ 
+ 
+ (module dp racket/base
+   (require "../define.rkt")
+   (define+provide (dp-f x #:y [y 42] . zs)
+     (apply + x y zs)))
+ 
+ (require 'dp)
+ (check-equal? (dp-f 1 #:y 0 2 3) 6)
+ 
+ (module dps racket/base
+   (require sugar/define)
+   (define+provide+safe (dps-f x #:y [y 42] . zs)
+     ((integer?) (#:y integer?) #:rest (listof integer?) . ->* . integer?)
+     (apply + x y zs)))
+ 
+ (require 'dps)
+ (check-equal? (dps-f 1 #:y 0 2 3) 6)
+ (require (prefix-in safe: (submod 'dps safe)))
+ (check-equal? (safe:dps-f 1 #:y 0 2 3) 6)
+ (check-exn exn:fail? (λ _ (safe:dps-f 'foo)))
+ 
+ (module ps racket/base
+   (require "../define.rkt")
+   (provide+safe [ps-f ((integer?) (#:y integer?) #:rest (listof integer?) . ->* . integer?)])
+   (define (ps-f x #:y [y 42] . zs)
+     (apply + x y zs)))
+ 
+ (require 'ps)
+ (check-equal? (ps-f 1 #:y 0 2 3) 6)
+ (require (prefix-in safe: (submod 'ps safe)))
+ (check-equal? (safe:ps-f 1 #:y 0 2 3) 6)
+ (check-exn exn:fail? (λ _ (safe:ps-f 'foo)))
+ 
+ (module dcp racket/base
+   (require "../define.rkt" rackunit)
+   (define/contract+provide (dcp-f x #:y [y 42] . zs)
+     ((integer?) (#:y integer?) #:rest (listof integer?) . ->* . integer?)
+     (apply + x y zs))
+   (check-exn exn:fail? (λ _ (dcp-f 'foo))))
+ 
+ (require 'dcp)
+ (check-equal? (dcp-f 1 #:y 0 2 3) 6)
+ (check-exn exn:fail? (λ _ (dcp-f 'foo)))
+ 
+ (module dpc racket/base
+   (require "../define.rkt" rackunit)
+   (define+provide/contract (dpc-f x #:y [y 42] . zs)
+     ((integer?) (#:y integer?) #:rest (listof integer?) . ->* . list?)
+     (list* x y zs))
+   (check-equal? (dpc-f 'foo) '(foo 42))) ; locally, no contract triggered
+ 
+ (require 'dpc)
+ (check-equal? (dpc-f 1) '(1 42))
+ (check-exn exn:fail? (λ _ (dpc-f 'foo)))
+ 
  (check-true (members-unique? '(a b c)))
  (check-false (members-unique? '(a b c c)))
  (check-true (members-unique? "zoey"))
@@ -152,9 +208,3 @@
  (check-equal? (values->list (shift/values ys '(-1 0 1) 'boing)) `((1 2 3 4 boing) ,xs (boing 0 1 2 3))))
 
 
-
-#|
-;; todo: revise `check-typing-fails` to make it compatible with 6.0
-(check-typing-fails (slice-at (range 5) 0)) ; needs a positive integer as second arg
-(check-typing-fails (slicef-at (range 5) 3)) ; needs a procedure as second arg
-|#