use new schemeunit
svn: r18361
This commit is contained in:
parent
dd31aa9512
commit
21d0dfcf09
|
@ -2,8 +2,7 @@
|
||||||
|
|
||||||
(provide go go/text)
|
(provide go go/text)
|
||||||
|
|
||||||
(require (planet schematics/schemeunit:2/test)
|
(require schemeunit schemeunit/text-ui
|
||||||
(planet schematics/schemeunit:2/text-ui)
|
|
||||||
mzlib/etc scheme/port
|
mzlib/etc scheme/port
|
||||||
compiler/compiler
|
compiler/compiler
|
||||||
scheme/match
|
scheme/match
|
||||||
|
@ -59,8 +58,7 @@
|
||||||
[current-directory path]
|
[current-directory path]
|
||||||
[current-output-port (open-output-nowhere)])
|
[current-output-port (open-output-nowhere)])
|
||||||
(loader p)))))))
|
(loader p)))))))
|
||||||
(apply test-suite dir
|
(make-test-suite dir tests)))
|
||||||
tests)))
|
|
||||||
|
|
||||||
(define (dr p)
|
(define (dr p)
|
||||||
#;((compile-zos #f) (list p) 'auto)
|
#;((compile-zos #f) (list p) 'auto)
|
||||||
|
@ -88,7 +86,7 @@
|
||||||
unit-tests int-tests))
|
unit-tests int-tests))
|
||||||
|
|
||||||
(define (go) (test/gui tests))
|
(define (go) (test/gui tests))
|
||||||
(define (go/text) (test/text-ui tests))
|
(define (go/text) (run-tests tests))
|
||||||
|
|
||||||
(provide go go/text)
|
(provide go go/text)
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,6 @@
|
||||||
|
|
||||||
(require
|
(require
|
||||||
"test-utils.ss"
|
"test-utils.ss"
|
||||||
"planet-requires.ss"
|
|
||||||
"typecheck-tests.ss" ;;fail
|
"typecheck-tests.ss" ;;fail
|
||||||
"subtype-tests.ss" ;; pass
|
"subtype-tests.ss" ;; pass
|
||||||
"type-equal-tests.ss" ;; pass
|
"type-equal-tests.ss" ;; pass
|
||||||
|
@ -13,18 +12,14 @@
|
||||||
"subst-tests.ss" ;; pass
|
"subst-tests.ss" ;; pass
|
||||||
"infer-tests.ss" ;; pass
|
"infer-tests.ss" ;; pass
|
||||||
"contract-tests.ss"
|
"contract-tests.ss"
|
||||||
)
|
(r:infer infer infer-dummy) schemeunit)
|
||||||
|
|
||||||
(require (r:infer infer infer-dummy)
|
|
||||||
(schemeunit))
|
|
||||||
|
|
||||||
(provide unit-tests)
|
(provide unit-tests)
|
||||||
|
|
||||||
(infer-param infer)
|
(infer-param infer)
|
||||||
|
|
||||||
(define unit-tests
|
(define unit-tests
|
||||||
(apply
|
(make-test-suite
|
||||||
test-suite
|
|
||||||
"Unit Tests"
|
"Unit Tests"
|
||||||
(for/list ([f (list
|
(for/list ([f (list
|
||||||
typecheck-tests
|
typecheck-tests
|
||||||
|
|
|
@ -1,13 +1,13 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require "test-utils.ss" "planet-requires.ss"
|
(require "test-utils.ss"
|
||||||
(for-syntax scheme/base)
|
(for-syntax scheme/base)
|
||||||
(for-template scheme/base)
|
(for-template scheme/base)
|
||||||
(private type-contract)
|
(private type-contract)
|
||||||
(rep type-rep filter-rep object-rep)
|
(rep type-rep filter-rep object-rep)
|
||||||
(types utils union convenience)
|
(types utils union convenience)
|
||||||
(utils tc-utils)
|
(utils tc-utils)
|
||||||
(schemeunit))
|
schemeunit)
|
||||||
|
|
||||||
(define-syntax-rule (t e)
|
(define-syntax-rule (t e)
|
||||||
(test-not-exn (format "~a" e) (lambda () (type->contract e (lambda _ (error "type could not be converted to contract"))))))
|
(test-not-exn (format "~a" e) (lambda () (type->contract e (lambda _ (error "type could not be converted to contract"))))))
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
|
(require "test-utils.ss" (for-syntax scheme/base))
|
||||||
(require (rep type-rep)
|
(require (rep type-rep)
|
||||||
(r:infer infer)
|
(r:infer infer)
|
||||||
(types convenience union utils abbrev)
|
(types convenience union utils abbrev)
|
||||||
(schemeunit))
|
schemeunit)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
#lang scheme
|
#lang scheme
|
||||||
(require "test-utils.ss" "planet-requires.ss")
|
(require "test-utils.ss" schemeunit)
|
||||||
(require (schemeunit))
|
|
||||||
|
|
||||||
(provide module-tests)
|
(provide module-tests)
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
|
(require "test-utils.ss" (for-syntax scheme/base)
|
||||||
(require (utils tc-utils)
|
(utils tc-utils)
|
||||||
(env type-alias-env type-environments type-name-env init-envs)
|
(env type-alias-env type-environments type-name-env init-envs)
|
||||||
(rep type-rep)
|
(rep type-rep)
|
||||||
(rename-in (types comparison subtype union utils convenience)
|
(rename-in (types comparison subtype union utils convenience)
|
||||||
|
@ -8,7 +8,7 @@
|
||||||
(private base-types-new base-types-extra colon)
|
(private base-types-new base-types-extra colon)
|
||||||
(for-template (private base-types-new base-types-extra base-env colon))
|
(for-template (private base-types-new base-types-extra base-env colon))
|
||||||
(private parse-type)
|
(private parse-type)
|
||||||
(schemeunit))
|
schemeunit)
|
||||||
|
|
||||||
(provide parse-type-tests)
|
(provide parse-type-tests)
|
||||||
|
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
|
(require "test-utils.ss" (for-syntax scheme/base)
|
||||||
(require (rep type-rep)
|
(rep type-rep)
|
||||||
(r:infer infer infer-dummy)
|
(r:infer infer infer-dummy)
|
||||||
(types convenience subtype union remove-intersect)
|
(types convenience subtype union remove-intersect)
|
||||||
(schemeunit))
|
schemeunit)
|
||||||
|
|
||||||
(define-syntax (over-tests stx)
|
(define-syntax (over-tests stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
|
(require "test-utils.ss" (for-syntax scheme/base)
|
||||||
(require (rep type-rep)
|
(rep type-rep)
|
||||||
(types utils abbrev)
|
(types utils abbrev)
|
||||||
(schemeunit))
|
schemeunit)
|
||||||
|
|
||||||
(define-syntax-rule (s img var tgt result)
|
(define-syntax-rule (s img var tgt result)
|
||||||
(test-eq? "test" (substitute img 'var tgt) result))
|
(test-eq? "test" (substitute img 'var tgt) result))
|
||||||
|
|
|
@ -1,12 +1,11 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require "test-utils.ss" "planet-requires.ss")
|
(require "test-utils.ss"
|
||||||
|
(types subtype convenience union)
|
||||||
(require (types subtype convenience union)
|
|
||||||
(rep type-rep)
|
(rep type-rep)
|
||||||
(env init-envs type-environments)
|
(env init-envs type-environments)
|
||||||
(r:infer infer infer-dummy)
|
(r:infer infer infer-dummy)
|
||||||
(schemeunit)
|
schemeunit
|
||||||
(for-syntax scheme/base))
|
(for-syntax scheme/base))
|
||||||
|
|
||||||
(provide subtype-tests)
|
(provide subtype-tests)
|
||||||
|
|
|
@ -1,27 +1,27 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(provide (all-defined-out))
|
(provide (all-defined-out))
|
||||||
|
|
||||||
(require "planet-requires.ss"
|
(require scheme/require-syntax
|
||||||
scheme/require-syntax
|
|
||||||
scheme/match
|
scheme/match
|
||||||
|
scheme/gui/dynamic
|
||||||
typed-scheme/utils/utils
|
typed-scheme/utils/utils
|
||||||
(for-syntax scheme/base))
|
(for-syntax scheme/base)
|
||||||
|
(types comparison utils)
|
||||||
|
schemeunit schemeunit/text-ui)
|
||||||
(require (types comparison utils)
|
|
||||||
(schemeunit))
|
|
||||||
|
|
||||||
(provide private typecheck (rename-out [infer r:infer]) utils env rep types)
|
(provide private typecheck (rename-out [infer r:infer]) utils env rep types)
|
||||||
|
|
||||||
(define (mk-suite ts)
|
(define (mk-suite ts)
|
||||||
(match (map (lambda (f) (f)) ts)
|
(match (map (lambda (f) (f)) ts)
|
||||||
[(list t) t]
|
[(list t) t]
|
||||||
[ts (apply test-suite "Combined Test Suite" ts)]))
|
[ts (make-test-suite "Combined Test Suite" ts)]))
|
||||||
|
|
||||||
(define (run . ts)
|
(define (run . ts)
|
||||||
(test/text-ui (mk-suite ts)))
|
(run-tests (mk-suite ts)))
|
||||||
|
|
||||||
(define (test/gui suite) ((dynamic-require '(planet schematics/schemeunit:2/graphical-ui) 'test/graphical-ui) suite))
|
(define (test/gui suite)
|
||||||
|
(((dynamic-require 'schemeunit/private/gui/gui 'make-gui-runner))
|
||||||
|
suite))
|
||||||
|
|
||||||
(define (run/gui . ts)
|
(define (run/gui . ts)
|
||||||
(test/gui (mk-suite ts)))
|
(test/gui (mk-suite ts)))
|
||||||
|
|
|
@ -1,12 +1,12 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require "test-utils.ss" "planet-requires.ss"
|
(require "test-utils.ss"
|
||||||
(for-syntax scheme/base))
|
(for-syntax scheme/base)
|
||||||
(require (private type-annotation parse-type base-types)
|
(private type-annotation parse-type base-types)
|
||||||
(types convenience utils)
|
(types convenience utils)
|
||||||
(env type-environments type-name-env init-envs)
|
(env type-environments type-name-env init-envs)
|
||||||
(utils tc-utils)
|
(utils tc-utils)
|
||||||
(rep type-rep)
|
(rep type-rep)
|
||||||
(schemeunit))
|
schemeunit)
|
||||||
|
|
||||||
(provide type-annotation-tests)
|
(provide type-annotation-tests)
|
||||||
|
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
|
(require "test-utils.ss" (for-syntax scheme/base)
|
||||||
(require (rep type-rep)
|
(rep type-rep)
|
||||||
(types comparison abbrev union)
|
(types comparison abbrev union)
|
||||||
(schemeunit))
|
schemeunit)
|
||||||
|
|
||||||
(provide type-equal-tests)
|
(provide type-equal-tests)
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require "test-utils.ss" "planet-requires.ss"
|
(require "test-utils.ss"
|
||||||
(for-syntax scheme/base)
|
(for-syntax scheme/base)
|
||||||
(for-template scheme/base))
|
(for-template scheme/base))
|
||||||
(require (private base-env prims type-annotation
|
(require (private base-env prims type-annotation
|
||||||
|
@ -15,20 +15,17 @@
|
||||||
(utils tc-utils utils)
|
(utils tc-utils utils)
|
||||||
unstable/mutated-vars
|
unstable/mutated-vars
|
||||||
(env type-name-env type-environments init-envs)
|
(env type-name-env type-environments init-envs)
|
||||||
(schemeunit)
|
schemeunit
|
||||||
syntax/parse)
|
syntax/parse
|
||||||
|
(for-syntax (utils tc-utils)
|
||||||
(require (for-syntax (utils tc-utils)
|
|
||||||
(typecheck typechecker)
|
(typecheck typechecker)
|
||||||
(env type-env)
|
(env type-env)
|
||||||
(private base-env base-env-numeric
|
(private base-env base-env-numeric
|
||||||
base-env-indexing-old))
|
base-env-indexing-old))
|
||||||
(for-template (private base-env base-types-new base-types-extra
|
(for-template (private base-env base-types-new base-types-extra
|
||||||
base-env-numeric
|
base-env-numeric
|
||||||
base-env-indexing-old)))
|
base-env-indexing-old))
|
||||||
|
(for-syntax syntax/kerncase syntax/parse))
|
||||||
|
|
||||||
(require (for-syntax syntax/kerncase syntax/parse))
|
|
||||||
|
|
||||||
(provide typecheck-tests g tc-expr/expand)
|
(provide typecheck-tests g tc-expr/expand)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user