Small style changes and removal of dead code.

Also adds a test to contract tests.
This commit is contained in:
Eric Dobson 2013-10-08 21:40:06 -07:00
parent b98eb0bc78
commit 20821f9ae8
13 changed files with 10 additions and 117 deletions

View File

@ -13,7 +13,6 @@
"type-annotation-test.rkt" ;; pass
"keyword-expansion-test.rkt" ;;pass
"module-tests.rkt" ;; pass
"contract-tests.rkt"
"interactive-tests.rkt"
@ -37,7 +36,6 @@
overlap-tests
parse-type-tests
type-annotation-tests
module-tests
fv-tests
contract-tests
keyword-tests
@ -50,6 +48,4 @@
(define-go (lambda () unit-tests))
;(go/gui)

View File

@ -7,6 +7,7 @@
(rep type-rep)
(types abbrev numeric-tower union)
rackunit)
(provide contract-tests)
(define-syntax-rule (t e)
@ -91,5 +92,3 @@
"multiple distinct type variables")
))
(define-go contract-tests)
(provide contract-tests)

View File

@ -75,10 +75,4 @@
(-> one two three true true result)
(-> one two false true false result)
(-> one false false false false result))]
))
(define-go keyword-tests)

View File

@ -1,14 +0,0 @@
#lang scheme
(require "test-utils.rkt" rackunit)
(provide module-tests)
(define (module-tests)
(test-suite "Tests for whole modules"
#;(test-not-exn "name" (lambda () (expand #'(module m (planet "typed-scheme.rkt" ("plt" "typed-scheme.plt"))
(define: x : number 3)))))
))
(define-go module-tests)

View File

@ -143,9 +143,3 @@
))
;; FIXME - add tests for parse-values-type, parse-tc-results
(define-go
parse-type-tests)

View File

@ -1,47 +0,0 @@
#lang scheme/base
(require (for-syntax scheme/base scheme/require-transform)
scheme/require-syntax)
(define-for-syntax (splice-requires specs)
(define subs (map (compose cons expand-import) specs))
(values (apply append (map car subs)) (apply append (map cdr subs))))
(define-syntax define-module
(syntax-rules ()
[(_ nm spec ...)
(define-syntax nm
(make-require-transformer
(lambda (stx)
(splice-requires (list (syntax-local-introduce (quote-syntax spec)) ...)))))]))
(define-syntax planet/multiple
(make-require-transformer
(lambda (stx)
(syntax-case stx ()
[(_ plt files ...)
(let ([mk (lambda (spc)
(syntax-case spc (prefix-in)
[e
(string? (syntax-e #'e))
(datum->syntax spc `(planet ,#'e ,#'plt) spc)]
[(prefix-in p e)
(datum->syntax spc `(prefix-in ,#'p (planet ,#'e ,#'plt)) spc)]))])
(splice-requires (map mk (syntax->list #'(files ...)))))]))))
(provide rackunit)
;; why is this neccessary?
(provide planet/multiple)
(define-module rackunit
(planet/multiple ("schematics" "rackunit.plt" 2 11)
"test.rkt"
;"graphical-ui.rkt"
"text-ui.rkt"
"util.rkt")
;; disabled until Carl updates to v4
#;
(planet/multiple ("cce" "fasttest.plt" 1 2)
"random.rkt"
"rackunit.rkt"))

View File

@ -1,6 +1,6 @@
#lang scheme/base
(require "test-utils.rkt" (for-syntax scheme/base)
(rep type-rep)
#lang racket/base
(require "test-utils.rkt"
(for-syntax racket/base)
(r:infer infer)
(types abbrev numeric-tower subtype union remove-intersect)
rackunit)
@ -66,20 +66,5 @@
[(-pair -Number (-v a)) (-pair Univ Univ) (Un)]
))
(define-go
restrict-tests
remove-tests
overlap-tests)
(define x1
(-mu list-rec
(Un
(-val '())
(-pair (-mu x (Un -Boolean -Number -String -Symbol (-val '()) (-pair x x)))
list-rec))))
(define x2
(Un (-val '())
(-pair (-mu x (Un -Boolean -Number -String -Symbol (-val '()) (-pair x x)))
(-mu x (Un -Boolean -Number -String -Symbol (-val '()) (-pair x x))))))
(provide remove-tests restrict-tests overlap-tests)

View File

@ -20,6 +20,7 @@
typed-racket/base-env/prims
typed-racket/base-env/base-types
(for-syntax typed-racket/standard-inits))
(provide typecheck-special-tests)
(begin-for-syntax (do-standard-inits))
@ -137,5 +138,3 @@
))
(define-go typecheck-special-tests)
(provide typecheck-special-tests)

View File

@ -1,6 +1,6 @@
#lang scheme/base
#lang racket/base
(require "test-utils.rkt" (for-syntax scheme/base)
(require "test-utils.rkt"
(rep type-rep)
(types utils abbrev numeric-tower substitute)
rackunit)
@ -19,6 +19,3 @@
(s... (-Number -Boolean) a (make-Function (list (make-arr-dots (list -String) -Number (-v b) 'a))) (-String (-v b) (-v b) . -> . -Number))
(s... (-Number -Boolean) a (make-Function (list (make-arr-dots (list -String) -Number (-v b) 'b)))
(make-Function (list (make-arr-dots (list -String) -Number (-v b) 'b))))))
(define-go subst-tests)

View File

@ -253,6 +253,3 @@
[(make-ListDots (-> -Symbol (make-F 'a)) 'a) (-lst (-> -Symbol Univ))]
))
(define-go
subtype-tests)

View File

@ -1,5 +1,4 @@
#lang scheme/base
(provide (all-defined-out))
(require scheme/require-syntax
scheme/match
@ -10,7 +9,7 @@
(rep type-rep)
rackunit rackunit/text-ui)
(provide private typecheck (rename-out [infer r:infer]) utils env rep types base-env)
(provide private typecheck (rename-out [infer r:infer]) utils env rep types base-env (all-defined-out))
(define (mk-suite ts)
(match (map (lambda (f) (f)) ts)

View File

@ -46,8 +46,3 @@
(-struct #'heap-node #f
(map fld* (list (-base 'comparator) -Number (-pair -Number -Number) (Un heap-node (-base 'heap-empty))))))
(-base 'heap-empty))]))
(define-go
type-equal-tests)

View File

@ -71,6 +71,8 @@
syntax/parse
'tester))
(provide typecheck-tests)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1945,6 +1947,3 @@
#:expected (-mu X (-pair (-vec (t:Un (-val ':a) X)) (t:Un (-val ':b) X)))]
[tc-l/err #(1 2) #:expected (make-HeterogeneousVector (list -Number -Symbol))]
))
(provide typecheck-tests)