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

refactored the contract system so that contracts do not depend on the class system, and now the class contracts are exported from class.ss

Browse Source 
svn: r7357

original commit: bd93217061d4304ed840fb1106666fabcbf0a930
This commit is contained in:
Robby Findler 2007-09-17 02:27:05 +00:00
parent 37265a7250
commit 388cdee4d0
3 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mzlib/class.ss
View File

@ -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")

3
collects/mzlib/contract.ss
View File

@ -21,7 +21,8 @@
;; from contract-guts.ss
(provide and/c
(provide any
and/c
any/c
none/c
make-none/c

19
collects/tests/mzscheme/contract-test.ss
View File

@ -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