Make tests more standardized.
original commit: 5ed67939b474d58e548a03edfb11cfbb2c7f7300
This commit is contained in:
Eric Dobson
parent
9c6d897d02
commit
56c8cec228
|
|
@ -1,238 +1,203 @@
|
|||
#lang racket/base
|
||||
|
||||
(require "test-utils.rkt"
|
||||
racket/list
|
||||
rackunit
|
||||
(static-contracts instantiate optimize combinators))
|
||||
racket/list racket/format rackunit
|
||||
(static-contracts instantiate optimize combinators)
|
||||
(for-syntax racket/base syntax/parse))
|
||||
|
||||
(provide tests)
|
||||
(gen-test-main)
|
||||
|
||||
(define-check (check-optimize variance* argument* expected*)
|
||||
(let ([variance variance*]
|
||||
[argument argument*]
|
||||
[expected expected*])
|
||||
(with-check-info*
|
||||
(list (make-check-info 'original argument)
|
||||
(make-check-expected expected))
|
||||
(lambda ()
|
||||
(define trusted-positive (equal? variance 'covariant))
|
||||
(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-syntax (check-optimize stx)
|
||||
(syntax-parse stx
|
||||
[(_ argument* #:pos positive-expected* #:neg negative-expected*)
|
||||
#'(test-case (~a 'argument*)
|
||||
(let ([argument argument*]
|
||||
[positive-expected positive-expected*]
|
||||
[negative-expected negative-expected*])
|
||||
(check-optimize-helper argument positive-expected #t #f)
|
||||
(check-optimize-helper argument negative-expected #f #t)))]))
|
||||
|
||||
(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
|
||||
(test-suite "Static Contract Optimizer Tests"
|
||||
;; Lists
|
||||
(check-optimize 'covariant
|
||||
(listof/sc any/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(listof/sc any/sc)
|
||||
list?/sc)
|
||||
(check-optimize 'covariant
|
||||
(listof/sc none/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(listof/sc none/sc)
|
||||
empty-list/sc)
|
||||
(check-optimize (listof/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg list?/sc)
|
||||
(check-optimize (listof/sc none/sc)
|
||||
#:pos any/sc
|
||||
#:neg empty-list/sc)
|
||||
|
||||
;; Heterogeneous Lists
|
||||
(check-optimize 'covariant
|
||||
(list/sc any/sc)
|
||||
any/sc)
|
||||
;; TODO fix ability to test equality here
|
||||
#;
|
||||
(check-optimize 'contravariant
|
||||
(list/sc any/sc)
|
||||
(list-length/sc 1))
|
||||
(check-optimize 'covariant
|
||||
(list/sc none/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(list/sc none/sc)
|
||||
none/sc)
|
||||
(check-optimize 'covariant
|
||||
(list/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(list/sc)
|
||||
empty-list/sc)
|
||||
|
||||
(check-optimize (list/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg (list-length/sc 1))
|
||||
(check-optimize (list/sc none/sc)
|
||||
#:pos any/sc
|
||||
#:neg none/sc)
|
||||
(check-optimize (list/sc)
|
||||
#:pos any/sc
|
||||
#:neg empty-list/sc)
|
||||
|
||||
;; Sets
|
||||
(check-optimize 'covariant
|
||||
(set/sc any/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(set/sc any/sc)
|
||||
set?/sc)
|
||||
(check-optimize 'covariant
|
||||
(set/sc none/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(set/sc none/sc)
|
||||
empty-set/sc)
|
||||
(check-optimize (set/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg set?/sc)
|
||||
(check-optimize (set/sc none/sc)
|
||||
#:pos any/sc
|
||||
#:neg empty-set/sc)
|
||||
|
||||
|
||||
;; Vectors
|
||||
(check-optimize 'covariant
|
||||
(vectorof/sc any/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(vectorof/sc any/sc)
|
||||
vector?/sc)
|
||||
(check-optimize 'covariant
|
||||
(vectorof/sc none/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(vectorof/sc none/sc)
|
||||
empty-vector/sc)
|
||||
(check-optimize (vectorof/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg vector?/sc)
|
||||
(check-optimize (vectorof/sc none/sc)
|
||||
#:pos any/sc
|
||||
#:neg empty-vector/sc)
|
||||
|
||||
;; Heterogeneous Vectors
|
||||
(check-optimize 'covariant
|
||||
(vector/sc any/sc)
|
||||
any/sc)
|
||||
;; TODO fix ability to test equality here
|
||||
#;
|
||||
(check-optimize 'contravariant
|
||||
(vector/sc any/sc)
|
||||
(vector-length/sc 1))
|
||||
(check-optimize 'covariant
|
||||
(vector/sc none/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(vector/sc none/sc)
|
||||
none/sc)
|
||||
(check-optimize 'covariant
|
||||
(vector/sc set?/sc)
|
||||
(vector/sc set?/sc))
|
||||
(check-optimize 'contravariant
|
||||
(vector/sc set?/sc)
|
||||
(vector/sc set?/sc))
|
||||
(check-optimize (vector/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg (vector-length/sc 1))
|
||||
(check-optimize (vector/sc none/sc)
|
||||
#:pos any/sc
|
||||
#:neg none/sc)
|
||||
;; TODO fix ability to test equality here
|
||||
#;
|
||||
(check-optimize (vector/sc)
|
||||
#:pos any/sc
|
||||
#:neg empty-vector/sc)
|
||||
(check-optimize (vector/sc set?/sc)
|
||||
#:pos (vector/sc set?/sc)
|
||||
#:neg (vector/sc set?/sc))
|
||||
|
||||
;; HashTables
|
||||
(check-optimize 'covariant
|
||||
(hash/sc any/sc any/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(hash/sc any/sc any/sc)
|
||||
hash?/sc)
|
||||
(check-optimize 'covariant
|
||||
(hash/sc none/sc any/sc)
|
||||
any/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)
|
||||
(check-optimize (hash/sc any/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg hash?/sc)
|
||||
(check-optimize (hash/sc none/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg empty-hash/sc)
|
||||
(check-optimize (hash/sc any/sc none/sc)
|
||||
#:pos any/sc
|
||||
#:neg empty-hash/sc)
|
||||
|
||||
;; And
|
||||
(check-optimize 'contravariant
|
||||
(and/sc set?/sc)
|
||||
set?/sc)
|
||||
(check-optimize 'contravariant
|
||||
(and/sc set?/sc any/sc)
|
||||
set?/sc)
|
||||
(check-optimize 'contravariant
|
||||
(and/sc set?/sc none/sc)
|
||||
none/sc)
|
||||
(check-optimize 'contravariant
|
||||
(and/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(and/sc any/sc any/sc)
|
||||
any/sc)
|
||||
(check-optimize (and/sc set?/sc)
|
||||
#:pos any/sc
|
||||
#:neg set?/sc)
|
||||
(check-optimize (and/sc set?/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg set?/sc)
|
||||
(check-optimize (and/sc set?/sc none/sc)
|
||||
#:pos any/sc
|
||||
#:neg none/sc)
|
||||
(check-optimize (and/sc)
|
||||
#:pos any/sc
|
||||
#:neg any/sc)
|
||||
(check-optimize (and/sc any/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg any/sc)
|
||||
|
||||
|
||||
;; Or
|
||||
(check-optimize 'contravariant
|
||||
(or/sc set?/sc)
|
||||
set?/sc)
|
||||
(check-optimize 'contravariant
|
||||
(or/sc set?/sc none/sc)
|
||||
set?/sc)
|
||||
(check-optimize 'contravariant
|
||||
(or/sc set?/sc any/sc)
|
||||
any/sc)
|
||||
(check-optimize 'covariant
|
||||
(or/sc)
|
||||
any/sc)
|
||||
(check-optimize 'contravariant
|
||||
(or/sc)
|
||||
none/sc)
|
||||
(check-optimize 'contravariant
|
||||
(or/sc any/sc any/sc)
|
||||
any/sc)
|
||||
(check-optimize (or/sc set?/sc)
|
||||
#:pos any/sc
|
||||
#:neg set?/sc)
|
||||
(check-optimize (or/sc set?/sc any/sc)
|
||||
#:pos any/sc
|
||||
#:neg any/sc)
|
||||
(check-optimize (or/sc set?/sc none/sc)
|
||||
#:pos any/sc
|
||||
#:neg set?/sc)
|
||||
(check-optimize (or/sc)
|
||||
#:pos any/sc
|
||||
#:neg none/sc)
|
||||
(check-optimize (or/sc none/sc none/sc)
|
||||
#:pos any/sc
|
||||
#:neg none/sc)
|
||||
|
||||
;; None
|
||||
(check-optimize 'covariant none/sc any/sc)
|
||||
(check-optimize 'contravariant none/sc none/sc)
|
||||
(check-optimize none/sc
|
||||
#:pos any/sc
|
||||
#:neg none/sc)
|
||||
|
||||
;; TODO add these test cases
|
||||
;; Boxes
|
||||
;; Syntax
|
||||
;; Promise
|
||||
|
||||
(check-optimize 'covariant
|
||||
(check-optimize
|
||||
(function/sc (list (listof/sc any/sc))
|
||||
(list)
|
||||
(list)
|
||||
(list)
|
||||
#f
|
||||
(list (listof/sc any/sc)))
|
||||
#:pos
|
||||
(function/sc (list list?/sc)
|
||||
(list)
|
||||
(list)
|
||||
(list)
|
||||
#f
|
||||
#f))
|
||||
(check-optimize 'contravariant
|
||||
(function/sc (list (listof/sc any/sc))
|
||||
(list)
|
||||
(list)
|
||||
(list)
|
||||
#f
|
||||
(list (listof/sc any/sc)))
|
||||
#f)
|
||||
#:neg
|
||||
(function/sc (list any/sc)
|
||||
(list)
|
||||
(list)
|
||||
(list)
|
||||
#f
|
||||
(list list?/sc)))
|
||||
(check-optimize 'contravariant
|
||||
(check-optimize
|
||||
(function/sc (list (listof/sc any/sc))
|
||||
(list)
|
||||
(list)
|
||||
(list)
|
||||
#f
|
||||
(list any/sc))
|
||||
#:pos
|
||||
(function/sc (list list?/sc)
|
||||
(list)
|
||||
(list)
|
||||
(list)
|
||||
#f
|
||||
#f)
|
||||
#:neg
|
||||
(function/sc (list any/sc)
|
||||
(list)
|
||||
(list)
|
||||
(list)
|
||||
#f
|
||||
(list any/sc)))
|
||||
(check-optimize 'covariant
|
||||
(case->/sc empty)
|
||||
(case->/sc empty))
|
||||
(check-optimize 'contravariant
|
||||
(case->/sc empty)
|
||||
(case->/sc empty))
|
||||
(check-optimize 'covariant
|
||||
(parameter/sc list?/sc (flat/sc #'symbol?))
|
||||
(parameter/sc list?/sc any/sc))
|
||||
(check-optimize 'contravariant
|
||||
|
||||
(check-optimize (case->/sc empty)
|
||||
#:pos (case->/sc empty)
|
||||
#:neg (case->/sc empty))
|
||||
(check-optimize (parameter/sc list?/sc set?/sc)
|
||||
#:pos (parameter/sc list?/sc any/sc)
|
||||
#:neg (parameter/sc any/sc set?/sc))
|
||||
|
||||
(check-optimize
|
||||
(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)))))
|
||||
(check-optimize 'covariant
|
||||
(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))))))
|
||||
#:pos (case->/sc (list (arr/sc (list list?/sc) (listof/sc set?/sc) #f)))
|
||||
#:neg (case->/sc (list (arr/sc (list any/sc) any/sc (list list?/sc)))))
|
||||
|
||||
))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user