diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/lengths.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/lengths.rkt index 30698237..1d9ce7b8 100644 --- a/typed-racket-lib/typed-racket/static-contracts/combinators/lengths.rkt +++ b/typed-racket-lib/typed-racket/static-contracts/combinators/lengths.rkt @@ -27,8 +27,7 @@ (define (list-length/sc* n) (if (zero? n) empty-list/sc - empty-vector/sc)) - + (list-length/sc n))) (define empty-list/sc (flat/sc #'null?)) (define empty-vector/sc (vector-length/sc 0)) diff --git a/typed-racket-test/unit-tests/static-contract-instantiate-tests.rkt b/typed-racket-test/unit-tests/static-contract-instantiate-tests.rkt new file mode 100644 index 00000000..9fd8fab7 --- /dev/null +++ b/typed-racket-test/unit-tests/static-contract-instantiate-tests.rkt @@ -0,0 +1,44 @@ +#lang racket/base + +;; Instantiate static contracts to contracts, +;; check that the contracts accept/reject the right values. + +(require "test-utils.rkt" "evaluator.rkt" + rackunit + (for-syntax + syntax/parse + racket/base + (static-contracts instantiate optimize combinators))) + +(provide tests) +(gen-test-main) + +(define-syntax sc->contract + (syntax-parser + [(_ sc:expr) + (syntax/loc #'e + (phase1-phase0-eval + (define defs+ctc (instantiate sc (lambda (#:reason _) (error "static-contract could not be converted to a contract")))) + #`(let () #,@(car defs+ctc) #,(cadr defs+ctc))))])) + +(define tests + (test-suite "Conversion Tests" + (let ([nat-ctc (sc->contract (flat/sc #'exact-nonnegative-integer?))]) + (check-true (nat-ctc 4)) + (check-false (nat-ctc -4))) + (let ([list-0 (sc->contract (list-length/sc 0))]) + (check-true (list-0 '())) + (check-false (list-0 '#())) + (check-false (list-0 '(1)))) + (let ([list-1 (sc->contract (list-length/sc 1))]) + (check-true (list-1 '(1))) + (check-false (list-1 '#())) + (check-false (list-1 '()))) + (let ([vector-0 (sc->contract (vector-length/sc 0))]) + (check-true (vector-0 '#())) + (check-false (vector-0 '())) + (check-false (vector-0 '#(1)))) + (let ([vector-1 (sc->contract (vector-length/sc 1))]) + (check-true (vector-1 '#(1))) + (check-false (vector-1 '#())) + (check-false (vector-1 '()))))) diff --git a/typed-racket-test/unit-tests/static-contract-optimizer-tests.rkt b/typed-racket-test/unit-tests/static-contract-optimizer-tests.rkt index fda559d9..b2f72883 100644 --- a/typed-racket-test/unit-tests/static-contract-optimizer-tests.rkt +++ b/typed-racket-test/unit-tests/static-contract-optimizer-tests.rkt @@ -85,8 +85,6 @@ #:neg empty-list/sc) ;; Heterogeneous Lists - ;; TODO fix ability to test equality here - #; (check-optimize (list/sc any/sc) #:pos any/sc #:neg (list-length/sc 1)) @@ -116,15 +114,12 @@ ;; Heterogeneous Vectors ;; TODO fix ability to test equality here - #; (check-optimize (vector/sc any/sc) #:pos any/sc #:neg (vector-length/sc 1)) (check-optimize (vector/sc none/sc) #:pos (vector/sc none/sc) #:neg (vector/sc none/sc)) - ;; TODO fix ability to test equality here - #; (check-optimize (vector/sc) #:pos any/sc #:neg empty-vector/sc)