From 8bc852da10794f89b4fc002d3f6944a81c985e68 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Tue, 14 Jan 2014 22:31:21 -0800 Subject: [PATCH] Add tests to check conversion of types to static contracts. original commit: 4ad412d71cfa616bccec6d9debe6cb478bda520c --- .../typed-racket/private/type-contract.rkt | 114 ++++++++++-------- .../unit-tests/contract-tests.rkt | 18 +++ 2 files changed, 81 insertions(+), 51 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt index dd762465..ad361c8f 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -21,8 +21,7 @@ (prefix-in c: racket/contract) (contract-req) (for-syntax racket/base syntax/parse racket/syntax) - (for-template racket/base racket/contract (utils any-wrap) - (prefix-in t: (types numeric-predicates)))) + (for-template racket/base racket/contract (utils any-wrap))) (provide (c:contract-out @@ -428,61 +427,74 @@ (case->/sc (map (f #t) arrs)))])] [_ (int-err "not a function" f)])) -(define-syntax-rule (numeric/sc name body) - (flat/sc #'(flat-named-contract 'name body) 'name)) (module predicates racket/base (provide nonnegative? nonpositive?) (define nonnegative? (lambda (x) (>= x 0))) (define nonpositive? (lambda (x) (<= x 0)))) -(require (for-template 'predicates)) -(define positive-byte/sc (numeric/sc Positive-Byte (and/c byte? positive?))) -(define byte/sc (numeric/sc Byte byte?)) -(define positive-index/sc (numeric/sc Positive-Index (and/c t:index? positive?))) -(define index/sc (numeric/sc Index t:index?)) -(define positive-fixnum/sc (numeric/sc Positive-Fixnum (and/c fixnum? positive?))) -(define nonnegative-fixnum/sc (numeric/sc Nonnegative-Fixnum (and/c fixnum? nonnegative?))) -(define nonpositive-fixnum/sc (numeric/sc Nonpositive-Fixnum (and/c fixnum? nonpositive?))) -(define fixnum/sc (numeric/sc Fixnum fixnum?)) -(define positive-integer/sc (numeric/sc Positive-Integer (and/c exact-integer? positive?))) -(define natural/sc (numeric/sc Natural exact-nonnegative-integer?)) -(define negative-integer/sc (numeric/sc Negative-Integer (and/c exact-integer? negative?))) -(define nonpositive-integer/sc (numeric/sc Nonpositive-Integer (and/c exact-integer? nonpostive?))) -(define integer/sc (numeric/sc Integer exact-integer?)) -(define positive-rational/sc (numeric/sc Positive-Rational (and/c t:exact-rational? positive?))) -(define nonnegative-rational/sc (numeric/sc Nonnegative-Rational (and/c t:exact-rational? nonnegative?))) -(define negative-rational/sc (numeric/sc Negative-Rational (and/c t:exact-rational? negative?))) -(define nonpositive-rational/sc (numeric/sc Nonpositive-Rational (and/c t:exact-rational? nonpositive?))) -(define rational/sc (numeric/sc Rational t:exact-rational?)) -(define flonum-zero/sc (numeric/sc Float-Zero (and/c flonum? zero?))) -(define nonnegative-flonum/sc (numeric/sc Nonnegative-Float (and/c flonum? nonnegative?))) -(define nonpositive-flonum/sc (numeric/sc Nonpositive-Float (and/c flonum? nonpositive?))) -(define flonum/sc (numeric/sc Float flonum?)) -(define single-flonum-zero/sc (numeric/sc Single-Flonum-Zero (and/c single-flonum? zero?))) -(define inexact-real-zero/sc (numeric/sc Inexact-Real-Zero (and/c inexact-real? zero?))) -(define positive-inexact-real/sc (numeric/sc Positive-Inexact-Real (and/c inexact-real? positive?))) -(define nonnegative-single-flonum/sc (numeric/sc Nonnegative-Single-Flonum (and/c single-flonum? nonnegative?))) -(define nonnegative-inexact-real/sc (numeric/sc Nonnegative-Inexact-Real (and/c inexact-real? nonpositive?))) -(define negative-inexact-real/sc (numeric/sc Negative-Inexact-Real (and/c inexact-real? negative?))) -(define nonpositive-single-flonum/sc (numeric/sc Nonpositive-Single-Flonum (and/c single-flonum? nonnegative?))) -(define nonpositive-inexact-real/sc (numeric/sc Nonpositive-Inexact-Real (and/c inexact-real? nonpositive?))) -(define single-flonum/sc (numeric/sc Single-Flonum single-flonum?)) -(define inexact-real/sc (numeric/sc Inexact-Real inexact-real?)) -(define real-zero/sc (numeric/sc Real-Zero (and/c real? zero?))) -(define positive-real/sc (numeric/sc Positive-Real (and/c real? positive?))) -(define nonnegative-real/sc (numeric/sc Nonnegative-Real (and/c real? nonnegative?))) -(define negative-real/sc (numeric/sc Negative-Real (and/c real? negative?))) -(define nonpositive-real/sc (numeric/sc Nonpositive-Real (and/c real? nonpositive?))) -(define real/sc (numeric/sc Real real?)) -(define exact-number/sc (numeric/sc Exact-Number (and/c number? exact?))) -(define inexact-complex/sc - (numeric/sc Inexact-Complex - (and/c number? - (lambda (x) - (and (inexact-real? (imag-part x)) - (inexact-real? (real-part x))))))) -(define number/sc (numeric/sc Number number?)) +(module numeric-contracts racket/base + (require + "../utils/utils.rkt" + (static-contracts combinators) + (for-template + racket/base + racket/contract + (submod ".." predicates) + (prefix-in t: (types numeric-predicates)))) + (provide (all-defined-out)) + (define-syntax-rule (numeric/sc name body) + (flat/sc #'(flat-named-contract 'name body) 'name)) + + (define positive-byte/sc (numeric/sc Positive-Byte (and/c byte? positive?))) + (define byte/sc (numeric/sc Byte byte?)) + (define positive-index/sc (numeric/sc Positive-Index (and/c t:index? positive?))) + (define index/sc (numeric/sc Index t:index?)) + (define positive-fixnum/sc (numeric/sc Positive-Fixnum (and/c fixnum? positive?))) + (define nonnegative-fixnum/sc (numeric/sc Nonnegative-Fixnum (and/c fixnum? nonnegative?))) + (define nonpositive-fixnum/sc (numeric/sc Nonpositive-Fixnum (and/c fixnum? nonpositive?))) + (define fixnum/sc (numeric/sc Fixnum fixnum?)) + (define positive-integer/sc (numeric/sc Positive-Integer (and/c exact-integer? positive?))) + (define natural/sc (numeric/sc Natural exact-nonnegative-integer?)) + (define negative-integer/sc (numeric/sc Negative-Integer (and/c exact-integer? negative?))) + (define nonpositive-integer/sc (numeric/sc Nonpositive-Integer (and/c exact-integer? nonpostive?))) + (define integer/sc (numeric/sc Integer exact-integer?)) + (define positive-rational/sc (numeric/sc Positive-Rational (and/c t:exact-rational? positive?))) + (define nonnegative-rational/sc (numeric/sc Nonnegative-Rational (and/c t:exact-rational? nonnegative?))) + (define negative-rational/sc (numeric/sc Negative-Rational (and/c t:exact-rational? negative?))) + (define nonpositive-rational/sc (numeric/sc Nonpositive-Rational (and/c t:exact-rational? nonpositive?))) + (define rational/sc (numeric/sc Rational t:exact-rational?)) + (define flonum-zero/sc (numeric/sc Float-Zero (and/c flonum? zero?))) + (define nonnegative-flonum/sc (numeric/sc Nonnegative-Float (and/c flonum? nonnegative?))) + (define nonpositive-flonum/sc (numeric/sc Nonpositive-Float (and/c flonum? nonpositive?))) + (define flonum/sc (numeric/sc Float flonum?)) + (define single-flonum-zero/sc (numeric/sc Single-Flonum-Zero (and/c single-flonum? zero?))) + (define inexact-real-zero/sc (numeric/sc Inexact-Real-Zero (and/c inexact-real? zero?))) + (define positive-inexact-real/sc (numeric/sc Positive-Inexact-Real (and/c inexact-real? positive?))) + (define nonnegative-single-flonum/sc (numeric/sc Nonnegative-Single-Flonum (and/c single-flonum? nonnegative?))) + (define nonnegative-inexact-real/sc (numeric/sc Nonnegative-Inexact-Real (and/c inexact-real? nonpositive?))) + (define negative-inexact-real/sc (numeric/sc Negative-Inexact-Real (and/c inexact-real? negative?))) + (define nonpositive-single-flonum/sc (numeric/sc Nonpositive-Single-Flonum (and/c single-flonum? nonnegative?))) + (define nonpositive-inexact-real/sc (numeric/sc Nonpositive-Inexact-Real (and/c inexact-real? nonpositive?))) + (define single-flonum/sc (numeric/sc Single-Flonum single-flonum?)) + (define inexact-real/sc (numeric/sc Inexact-Real inexact-real?)) + (define real-zero/sc (numeric/sc Real-Zero (and/c real? zero?))) + (define positive-real/sc (numeric/sc Positive-Real (and/c real? positive?))) + (define nonnegative-real/sc (numeric/sc Nonnegative-Real (and/c real? nonnegative?))) + (define negative-real/sc (numeric/sc Negative-Real (and/c real? negative?))) + (define nonpositive-real/sc (numeric/sc Nonpositive-Real (and/c real? nonpositive?))) + (define real/sc (numeric/sc Real real?)) + (define exact-number/sc (numeric/sc Exact-Number (and/c number? exact?))) + (define inexact-complex/sc + (numeric/sc Inexact-Complex + (and/c number? + (lambda (x) + (and (inexact-real? (imag-part x)) + (inexact-real? (real-part x))))))) + (define number/sc (numeric/sc Number number?)) + + ) +(require 'numeric-contracts) (define (numeric-type->static-contract type) (match type diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt index 8fe6f81f..0d0c1c30 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt @@ -6,6 +6,7 @@ (private type-contract) (rep type-rep) (types abbrev numeric-tower union) + (submod typed-racket/private/type-contract numeric-contracts) rackunit) (provide tests) (gen-test-main) @@ -20,6 +21,20 @@ (λ (#:reason [reason #f]) (fail-check (or reason "Type could not be converted to contract")))))))) +(define-syntax-rule (t-sc e-t e-sc) + (test-case (format "~a" '(e-t -> e-sc)) + (let ([t e-t] [sc e-sc]) + (with-check-info (['type t] ['expected sc]) + (define actual + (type->static-contract + t + (λ (#:reason [reason #f]) + (fail-check (or reason "Type could not be converted to contract"))))) + (with-check-info (['actual actual]) + (unless (equal? actual sc) + (fail-check "Static contract didn't match expected"))))))) + + (define-syntax-rule (t/fail e expected-reason) (test-case (format "~a" 'e) (let ((v e)) @@ -105,4 +120,7 @@ (t/fail (-vec (-struct #'struct-name #f (list (make-fld (-seq -Symbol) #'acc #f)) #f #t)) "required a chaperone contract but generated an impersonator contract") + (t-sc -Number number/sc) + (t-sc -Integer integer/sc) + ))