suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make tests more standardized.

Browse Source
This commit is contained in:
Eric Dobson 2013-12-18 09:40:26 -08:00
parent 6cfb035b3f
commit 5ed67939b4
1 changed files with 135 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

305
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
View File

@ -1,238 +1,203 @@
#lang racket/base #lang racket/base
(require "test-utils.rkt" (require "test-utils.rkt"
racket/list racket/list racket/format rackunit
rackunit (static-contracts instantiate optimize combinators)
(static-contracts instantiate optimize combinators)) (for-syntax racket/base syntax/parse))
(provide tests) (provide tests)
(gen-test-main) (gen-test-main)
(define-check (check-optimize variance* argument* expected*) (define-syntax (check-optimize stx)
(let ([variance variance*] (syntax-parse stx
[argument argument*] [(_ argument* #:pos positive-expected* #:neg negative-expected*)
[expected expected*]) #'(test-case (~a 'argument*)
(with-check-info* (let ([argument argument*]
(list (make-check-info 'original argument) [positive-expected positive-expected*]
(make-check-expected expected)) [negative-expected negative-expected*])
(lambda () (check-optimize-helper argument positive-expected #t #f)
(define trusted-positive (equal? variance 'covariant)) (check-optimize-helper argument negative-expected #f #t)))]))
(define trusted-negative (equal? variance 'contravariant))
(let ([opt (optimize argument
#:trusted-positive trusted-positive
#:trusted-negative trusted-negative)])
(with-check-info* (list (make-check-actual opt))
(lambda ()
(unless (equal? opt expected)
(fail-check)))))))))
(define (check-optimize-helper argument expected trusted-positive trusted-negative)
(with-check-info*
(list (make-check-info 'original argument)
(make-check-expected expected))
(λ ()
(let ([opt (optimize argument
#:trusted-positive trusted-positive
#:trusted-negative trusted-negative)])
(with-check-info* (list (make-check-actual opt))
(lambda ()
(unless (equal? opt expected)
(fail-check))))))))
(define tests (define tests
(test-suite "Static Contract Optimizer Tests" (test-suite "Static Contract Optimizer Tests"
;; Lists ;; Lists
(check-optimize 'covariant (check-optimize (listof/sc any/sc)
(listof/sc any/sc) #:pos any/sc
any/sc) #:neg list?/sc)
(check-optimize 'contravariant (check-optimize (listof/sc none/sc)
(listof/sc any/sc) #:pos any/sc
list?/sc) #:neg empty-list/sc)
(check-optimize 'covariant
(listof/sc none/sc)
any/sc)
(check-optimize 'contravariant
(listof/sc none/sc)
empty-list/sc)
;; Heterogeneous Lists ;; Heterogeneous Lists
(check-optimize 'covariant
(list/sc any/sc)
any/sc)
;; TODO fix ability to test equality here ;; TODO fix ability to test equality here
#; #;
(check-optimize 'contravariant (check-optimize (list/sc any/sc)
(list/sc any/sc) #:pos any/sc
(list-length/sc 1)) #:neg (list-length/sc 1))
(check-optimize 'covariant (check-optimize (list/sc none/sc)
(list/sc none/sc) #:pos any/sc
any/sc) #:neg none/sc)
(check-optimize 'contravariant (check-optimize (list/sc)
(list/sc none/sc) #:pos any/sc
none/sc) #:neg empty-list/sc)
(check-optimize 'covariant
(list/sc)
any/sc)
(check-optimize 'contravariant
(list/sc)
empty-list/sc)
;; Sets ;; Sets
(check-optimize 'covariant (check-optimize (set/sc any/sc)
(set/sc any/sc) #:pos any/sc
any/sc) #:neg set?/sc)
(check-optimize 'contravariant (check-optimize (set/sc none/sc)
(set/sc any/sc) #:pos any/sc
set?/sc) #:neg empty-set/sc)
(check-optimize 'covariant
(set/sc none/sc)
any/sc)
(check-optimize 'contravariant
(set/sc none/sc)
empty-set/sc)
;; Vectors ;; Vectors
(check-optimize 'covariant (check-optimize (vectorof/sc any/sc)
(vectorof/sc any/sc) #:pos any/sc
any/sc) #:neg vector?/sc)
(check-optimize 'contravariant (check-optimize (vectorof/sc none/sc)
(vectorof/sc any/sc) #:pos any/sc
vector?/sc) #:neg empty-vector/sc)
(check-optimize 'covariant
(vectorof/sc none/sc)
any/sc)
(check-optimize 'contravariant
(vectorof/sc none/sc)
empty-vector/sc)
;; Heterogeneous Vectors ;; Heterogeneous Vectors
(check-optimize 'covariant
(vector/sc any/sc)
any/sc)
;; TODO fix ability to test equality here ;; TODO fix ability to test equality here
#; #;
(check-optimize 'contravariant (check-optimize (vector/sc any/sc)
(vector/sc any/sc) #:pos any/sc
(vector-length/sc 1)) #:neg (vector-length/sc 1))
(check-optimize 'covariant (check-optimize (vector/sc none/sc)
(vector/sc none/sc) #:pos any/sc
any/sc) #:neg none/sc)
(check-optimize 'contravariant ;; TODO fix ability to test equality here
(vector/sc none/sc) #;
none/sc) (check-optimize (vector/sc)
(check-optimize 'covariant #:pos any/sc
(vector/sc set?/sc) #:neg empty-vector/sc)
(vector/sc set?/sc)) (check-optimize (vector/sc set?/sc)
(check-optimize 'contravariant #:pos (vector/sc set?/sc)
(vector/sc set?/sc) #:neg (vector/sc set?/sc))
(vector/sc set?/sc))
;; HashTables ;; HashTables
(check-optimize 'covariant (check-optimize (hash/sc any/sc any/sc)
(hash/sc any/sc any/sc) #:pos any/sc
any/sc) #:neg hash?/sc)
(check-optimize 'contravariant (check-optimize (hash/sc none/sc any/sc)
(hash/sc any/sc any/sc) #:pos any/sc
hash?/sc) #:neg empty-hash/sc)
(check-optimize 'covariant (check-optimize (hash/sc any/sc none/sc)
(hash/sc none/sc any/sc) #:pos any/sc
any/sc) #:neg empty-hash/sc)
(check-optimize 'covariant
(hash/sc any/sc none/sc)
any/sc)
(check-optimize 'contravariant
(hash/sc none/sc any/sc)
empty-hash/sc)
(check-optimize 'contravariant
(hash/sc any/sc none/sc)
empty-hash/sc)
;; And ;; And
(check-optimize 'contravariant (check-optimize (and/sc set?/sc)
(and/sc set?/sc) #:pos any/sc
set?/sc) #:neg set?/sc)
(check-optimize 'contravariant (check-optimize (and/sc set?/sc any/sc)
(and/sc set?/sc any/sc) #:pos any/sc
set?/sc) #:neg set?/sc)
(check-optimize 'contravariant (check-optimize (and/sc set?/sc none/sc)
(and/sc set?/sc none/sc) #:pos any/sc
none/sc) #:neg none/sc)
(check-optimize 'contravariant (check-optimize (and/sc)
(and/sc) #:pos any/sc
any/sc) #:neg any/sc)
(check-optimize 'contravariant (check-optimize (and/sc any/sc any/sc)
(and/sc any/sc any/sc) #:pos any/sc
any/sc) #:neg any/sc)
;; Or ;; Or
(check-optimize 'contravariant (check-optimize (or/sc set?/sc)
(or/sc set?/sc) #:pos any/sc
set?/sc) #:neg set?/sc)
(check-optimize 'contravariant (check-optimize (or/sc set?/sc any/sc)
(or/sc set?/sc none/sc) #:pos any/sc
set?/sc) #:neg any/sc)
(check-optimize 'contravariant (check-optimize (or/sc set?/sc none/sc)
(or/sc set?/sc any/sc) #:pos any/sc
any/sc) #:neg set?/sc)
(check-optimize 'covariant (check-optimize (or/sc)
(or/sc) #:pos any/sc
any/sc) #:neg none/sc)
(check-optimize 'contravariant (check-optimize (or/sc none/sc none/sc)
(or/sc) #:pos any/sc
none/sc) #:neg none/sc)
(check-optimize 'contravariant
(or/sc any/sc any/sc)
any/sc)
;; None ;; None
(check-optimize 'covariant none/sc any/sc) (check-optimize none/sc
(check-optimize 'contravariant none/sc none/sc) #:pos any/sc
#:neg none/sc)
;; TODO add these test cases ;; TODO add these test cases
;; Boxes ;; Boxes
;; Syntax ;; Syntax
;; Promise ;; Promise
(check-optimize 'covariant (check-optimize
(function/sc (list (listof/sc any/sc)) (function/sc (list (listof/sc any/sc))
(list) (list)
(list) (list)
(list) (list)
#f #f
(list (listof/sc any/sc))) (list (listof/sc any/sc)))
#:pos
(function/sc (list list?/sc) (function/sc (list list?/sc)
(list) (list)
(list) (list)
(list) (list)
#f #f
#f)) #f)
(check-optimize 'contravariant #:neg
(function/sc (list (listof/sc any/sc))
(list)
(list)
(list)
#f
(list (listof/sc any/sc)))
(function/sc (list any/sc) (function/sc (list any/sc)
(list) (list)
(list) (list)
(list) (list)
#f #f
(list list?/sc))) (list list?/sc)))
(check-optimize 'contravariant (check-optimize
(function/sc (list (listof/sc any/sc)) (function/sc (list (listof/sc any/sc))
(list) (list)
(list) (list)
(list) (list)
#f #f
(list any/sc)) (list any/sc))
#:pos
(function/sc (list list?/sc)
(list)
(list)
(list)
#f
#f)
#:neg
(function/sc (list any/sc) (function/sc (list any/sc)
(list) (list)
(list) (list)
(list) (list)
#f #f
(list any/sc))) (list any/sc)))
(check-optimize 'covariant
(case->/sc empty) (check-optimize (case->/sc empty)
(case->/sc empty)) #:pos (case->/sc empty)
(check-optimize 'contravariant #:neg (case->/sc empty))
(case->/sc empty) (check-optimize (parameter/sc list?/sc set?/sc)
(case->/sc empty)) #:pos (parameter/sc list?/sc any/sc)
(check-optimize 'covariant #:neg (parameter/sc any/sc set?/sc))
(parameter/sc list?/sc (flat/sc #'symbol?))
(parameter/sc list?/sc any/sc)) (check-optimize
(check-optimize 'contravariant
(case->/sc (list (arr/sc (list (listof/sc any/sc)) (listof/sc (set/sc any/sc)) (list (listof/sc any/sc))))) (case->/sc (list (arr/sc (list (listof/sc any/sc)) (listof/sc (set/sc any/sc)) (list (listof/sc any/sc)))))
(case->/sc (list (arr/sc (list any/sc) any/sc (list list?/sc))))) #:pos (case->/sc (list (arr/sc (list list?/sc) (listof/sc set?/sc) #f)))
(check-optimize 'covariant #:neg (case->/sc (list (arr/sc (list any/sc) any/sc (list list?/sc)))))
(case->/sc (list (arr/sc (list (listof/sc any/sc)) (listof/sc (set/sc any/sc)) (list (listof/sc any/sc)))))
(case->/sc (list (arr/sc (list list?/sc) (listof/sc set?/sc) #f)))))) ))