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

Add a bunch of unit tests for open-Values.

Browse Source
This commit is contained in:
Eric Dobson 2014-05-29 18:59:13 -07:00
parent 2922440fdd
commit 8e63b65fa2
1 changed files with 63 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/metafunction-tests.rkt
View File

@ -2,9 +2,9 @@
(require "test-utils.rkt" (require "test-utils.rkt"
rackunit racket/format rackunit racket/format
(typecheck tc-metafunctions tc-subst)
(rep filter-rep type-rep object-rep)
(types abbrev union filter-ops tc-result) (types abbrev union filter-ops tc-result)
(typecheck tc-metafunctions)
(rep object-rep)
(for-syntax racket/base syntax/parse)) (for-syntax racket/base syntax/parse))
(provide tests) (provide tests)
@ -39,7 +39,6 @@
(list (-or (-filter -String #'y) (-filter -String #'x)) (list (-or (-filter -String #'y) (-filter -String #'x))
(-filter (Un -String -Symbol) #'y) (-filter (Un -String -Symbol) #'x)) (-filter (Un -String -Symbol) #'y) (-filter (Un -String -Symbol) #'x))
#t) #t)
) )
(test-suite "merge-tc-results" (test-suite "merge-tc-results"
@ -70,7 +69,68 @@
(check-equal? (check-equal?
(merge-tc-results (list (ret null null null -Symbol 'x) (ret null null null -String 'x))) (merge-tc-results (list (ret null null null -Symbol 'x) (ret null null null -String 'x)))
(ret null null null (Un -Symbol -String) 'x)) (ret null null null (Un -Symbol -String) 'x))
)
(test-suite "open-Values"
(check-equal?
(open-Values (make-Values (list (-result -Symbol))) (list -empty-obj) (list Univ))
(ret -Symbol))
(check-equal?
(open-Values (make-Values (list (-result -Symbol) (-result -String)))
(list -empty-obj -empty-obj) (list Univ Univ))
(ret (list -Symbol -String)))
(check-equal?
(open-Values (make-Values (list (-result -Symbol (-FS -top -bot)))) (list -empty-obj) (list Univ))
(ret -Symbol (-FS -top -bot)))
(check-equal?
(open-Values (make-Values (list (-result -Symbol (-FS -top -bot) (make-Path null '(0 0)))))
(list -empty-obj) (list Univ))
(ret -Symbol (-FS -top -bot)))
(check-equal?
(open-Values (make-Values (list (-result (-opt -Symbol) (-FS (-filter -String '(0 0)) -top))))
(list -empty-obj) (list Univ))
(ret (-opt -Symbol) -top-filter))
(check-equal?
(open-Values (make-Values (list (-result (-opt -Symbol) (-FS (-not-filter -String '(0 0)) -top))))
(list -empty-obj) (list Univ))
(ret (-opt -Symbol) -top-filter))
(check-equal?
(open-Values (make-Values (list (-result (-opt -Symbol) (-FS (-imp (-not-filter (-val #f) '(0 0))
(-not-filter -String #'x))
-top))))
(list -empty-obj) (list Univ))
(ret (-opt -Symbol) -top-filter))
(check-equal?
(open-Values (make-Values (list (-result (-opt -Symbol) (-FS (-not-filter -String '(0 0)) -top)
(make-Path null '(0 0)))))
(list (make-Path null #'x)) (list Univ))
(ret (-opt -Symbol) (-FS (-not-filter -String #'x) -top) (make-Path null #'x)))
;; Check additional filters
(check-equal?
(open-Values (make-Values (list (-result (-opt -Symbol) (-FS (-not-filter -String '(0 0)) -top)
(make-Path null '(0 0)))))
(list (make-Path null #'x)) (list -String))
(ret (-opt -Symbol) -false-filter (make-Path null #'x)))
;; Substitute into ranges correctly
(check-equal?
(open-Values (make-Values (list (-result (-opt (-> Univ -Boolean : (-FS (-filter -Symbol '(0 0)) -top))))))
(list (make-Path null #'x)) (list Univ))
(ret (-opt (-> Univ -Boolean : (-FS (-filter -Symbol '(0 0)) -top)))))
(check-equal?
(open-Values (make-Values (list (-result (-opt (-> Univ -Boolean : (-FS (-filter -Symbol '(1 0)) -top))))))
(list (make-Path null #'x)) (list Univ))
(ret (-opt (-> Univ -Boolean : (-FS (-filter -Symbol #'x) -top)))))
) )
)) ))