diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.ss index 536df91..08dae8b 100644 --- a/collects/mzlib/class.ss +++ b/collects/mzlib/class.ss @@ -1,5 +1,9 @@ (module class mzscheme + ;; povide contracts for objects + (require "private/contract-object.ss") + (provide (all-from "private/contract-object.ss")) + ;; All of the implementation is actually in private/class-internal.ss, ;; which provides extra (private) functionality to contract.ss. (require "private/class-internal.ss") diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss index 8a8f09e..1b4c1c7 100644 --- a/collects/mzlib/contract.ss +++ b/collects/mzlib/contract.ss @@ -21,7 +21,8 @@ ;; from contract-guts.ss - (provide and/c + (provide any + and/c any/c none/c make-none/c diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index f726d8b..5504e46 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -4366,6 +4366,8 @@ so that propagation occurs. (test-name 'printable/c printable/c) (test-name '(symbols 'a 'b 'c) (symbols 'a 'b 'c)) (test-name '(one-of/c 1 2 3) (one-of/c 1 2 3)) + (test-name '(one-of/c '() 'x 1 #f #\a (void) (letrec ([x x]) x)) + (one-of/c '() 'x 1 #f #\a (void) (letrec ([x x]) x))) (test-name '(subclass?/c class:c%) (let ([c% (class object% (super-new))]) (subclass?/c c%))) @@ -5169,7 +5171,22 @@ so that propagation occurs. (define-syntax (unit-body stx) f f #'1))))) - + + (test/spec-passed + 'provide/contract22 + '(begin + (eval '(module provide/contract22a mzscheme + (require (lib "contract.ss")) + (provide/contract [make-bound-identifier-mapping integer?]) + (define make-bound-identifier-mapping 1))) + (eval '(module provide/contract22b mzscheme + (require-for-syntax provide/contract22a) + + (define-syntax (unit-body stx) + make-bound-identifier-mapping) + + (define-syntax (f stx) + make-bound-identifier-mapping))))) (contract-error-test #'(begin