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

planet-requires moved to tests/typed-scheme/util-tests

Browse Source 
svn: r11937
This commit is contained in:
Eli Barzilay 2008-10-05 03:40:55 +00:00
parent 0d6a9d73dc
commit 2899c1f1cc
14 changed files with 107 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/typed-scheme/main.ss
View File

@ -86,7 +86,7 @@
(define (go) (test/gui tests))
(define (go/text) (test/text-ui tests))
(go/text)
(when (getenv "PLT_TESTS")
(unless (parameterize ([current-output-port (open-output-string)])
(= 0 (go/text)))

6
collects/tests/typed-scheme/unit-tests/all-tests.ss
View File

@ -2,6 +2,7 @@
(require
"test-utils.ss"
"planet-requires.ss"
"typecheck-tests.ss"
"subtype-tests.ss" ;; done
"type-equal-tests.ss" ;; done
@ -12,9 +13,8 @@
"subst-tests.ss"
"infer-tests.ss")
(require (utils planet-requires) (r:infer infer infer-dummy))
(require (schemeunit))
(require (r:infer infer infer-dummy)
(schemeunit))
(provide unit-tests)

9
collects/tests/typed-scheme/unit-tests/infer-tests.ss
View File

@ -1,11 +1,10 @@
#lang scheme/base
(require "test-utils.ss" (for-syntax scheme/base))
(require (utils planet-requires)
(rep type-rep)
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
(require (rep type-rep)
(r:infer infer)
(private type-effect-convenience union type-utils)
(prefix-in table: (utils tables)))
(require (schemeunit))
(prefix-in table: (utils tables))
(schemeunit))

3
collects/tests/typed-scheme/unit-tests/module-tests.ss
View File

@ -1,6 +1,5 @@
#lang scheme
(require "test-utils.ss")
(require (utils planet-requires))
(require "test-utils.ss" "planet-requires.ss")
(require (schemeunit))
(provide module-tests)

8
collects/tests/typed-scheme/unit-tests/new-fv-tests.ss
View File

@ -1,8 +1,8 @@
(module new-fv-tests mzscheme
(require "test-utils.ss")
(require/private type-rep rep-utils planet-requires type-effect-convenience meet-join subtype union)
(require-schemeunit)
(require "test-utils.ss" "planet-requires.ss")
(require/private type-rep rep-utils type-effect-convenience meet-join subtype union)
(require-schemeunit)
(define variance-gen (random-uniform Covariant Contravariant Invariant Constant))
(define alpha-string (random-string (random-char (random-int-between 65 90)) (random-size 1)))

9
collects/tests/typed-scheme/unit-tests/parse-type-tests.ss
View File

@ -1,17 +1,16 @@
#lang scheme/base
(require "test-utils.ss" (for-syntax scheme/base))
(require (utils planet-requires tc-utils)
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
(require (utils tc-utils)
(env type-alias-env type-environments type-name-env init-envs)
(rep type-rep)
(private type-comparison parse-type subtype
union type-utils))
union type-utils)
(schemeunit))
(require (rename-in (private type-effect-convenience) [-> t:->])
(except-in (private base-types) Un)
(for-template (private base-types)))
(require (schemeunit))
(provide parse-type-tests)
;; HORRIBLE HACK!

64
collects/tests/typed-scheme/unit-tests/planet-requires.ss Normal file
View File

@ -0,0 +1,64 @@
#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-require-syntax nm
(lambda (stx)
(syntax-case stx ()
[(_) (datum->syntax stx (syntax->datum #'(combine-in spec ...)))])))]))
#;
(define-syntax define-module
(lambda (stx)
(syntax-case stx ()
[(_ nm spec ...)
(syntax/loc stx
(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 schemeunit)
;; why is this neccessary?
(provide planet/multiple)
(define-module schemeunit
(planet/multiple ("schematics" "schemeunit.plt" 2 3)
"test.ss"
;"graphical-ui.ss"
"text-ui.ss"
"util.ss")
;; disabled until Carl updates to v4
#;
(planet/multiple ("cce" "fasttest.plt" 1 2)
"random.ss"
"schemeunit.ss"))

8
collects/tests/typed-scheme/unit-tests/remove-intersect-tests.ss
View File

@ -1,11 +1,9 @@
#lang scheme/base
(require "test-utils.ss" (for-syntax scheme/base))
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
(require (rep type-rep)
(utils planet-requires)
(r:infer infer)
(private type-effect-convenience remove-intersect subtype union))
(require (schemeunit))
(private type-effect-convenience remove-intersect subtype union)
(schemeunit))
(define-syntax (restr-tests stx)
(syntax-case stx ()

9
collects/tests/typed-scheme/unit-tests/subst-tests.ss
View File

@ -1,10 +1,9 @@
#lang scheme/base
(require "test-utils.ss" (for-syntax scheme/base))
(require (utils planet-requires)
(rep type-rep)
(private type-utils type-effect-convenience))
(require (schemeunit))
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
(require (rep type-rep)
(private type-utils type-effect-convenience)
(schemeunit))
(define-syntax-rule (s img var tgt result)
(test-eq? "test" (substitute img 'var tgt) result))

9
collects/tests/typed-scheme/unit-tests/subtype-tests.ss
View File

@ -1,15 +1,12 @@
#lang scheme/base
(require "test-utils.ss")
(require "test-utils.ss" "planet-requires.ss")
(require (private subtype type-effect-convenience union)
(rep type-rep)
(utils planet-requires)
(env init-envs type-environments)
(r:infer infer infer-dummy))
(require (schemeunit)
(r:infer infer infer-dummy)
(schemeunit)
(for-syntax scheme/base))
(provide subtype-tests)

7
collects/tests/typed-scheme/unit-tests/test-utils.ss
View File

@ -1,15 +1,16 @@
#lang scheme/base
(provide (all-defined-out))
(require scheme/require-syntax
(require "planet-requires.ss"
scheme/require-syntax
scheme/match
typed-scheme/utils/utils
(for-syntax scheme/base))
(require (utils planet-requires) (private type-comparison type-utils))
(require (private type-comparison type-utils)
(schemeunit))
(provide private typecheck (rename-out [infer r:infer]) utils env rep)
(require (schemeunit))
(define (mk-suite ts)
(match (map (lambda (f) (f)) ts)

9
collects/tests/typed-scheme/unit-tests/type-annotation-test.ss
View File

@ -1,12 +1,11 @@
#lang scheme/base
(require "test-utils.ss"
(require "test-utils.ss" "planet-requires.ss"
(for-syntax scheme/base))
(require (private type-annotation type-effect-convenience parse-type)
(env type-environments type-name-env init-envs)
(utils planet-requires tc-utils)
(rep type-rep))
(require (schemeunit))
(utils tc-utils)
(rep type-rep)
(schemeunit))
(provide type-annotation-tests)

8
collects/tests/typed-scheme/unit-tests/type-equal-tests.ss
View File

@ -1,9 +1,9 @@
#lang scheme/base
(require "test-utils.ss" (for-syntax scheme/base))
(require (utils planet-requires) (rep type-rep)
(private type-comparison type-effect-convenience union subtype))
(require (schemeunit))
(require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
(require (rep type-rep)
(private type-comparison type-effect-convenience union subtype)
(schemeunit))
(provide type-equal-tests)

9
collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
View File

@ -1,21 +1,20 @@
#lang scheme/base
(require "test-utils.ss"
(require "test-utils.ss" "planet-requires.ss"
(for-syntax scheme/base)
(for-template scheme/base))
(require (private base-env mutated-vars type-utils union prims type-effect-convenience type-annotation)
(typecheck typechecker)
(rep type-rep effect-rep)
(utils tc-utils planet-requires)
(env type-name-env type-environments init-envs))
(utils tc-utils)
(env type-name-env type-environments init-envs)
(schemeunit))
(require (for-syntax (utils tc-utils)
(typecheck typechecker)
(env type-env)
(private base-env))
(for-template (private base-env base-types)))
(require (schemeunit))