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

..

Browse Source 
original commit: 8fec40b07f04e66a5426250d7ace86d726023922
This commit is contained in:
Robby Findler 2002-10-29 23:59:22 +00:00
parent 5f5a95a9a9
commit 7f509d5207
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/mzlib/contracts.ss
View File

@ -204,14 +204,16 @@
(build-constructor-contract field-contract-ids
predicate-id))]
[(field-contracts ...) field-contracts]
[(field-contract-ids ...) field-contract-ids])
[(field-contract-ids ...) field-contract-ids]
[struct-name struct-name])
(syntax
(begin
(define field-contract-ids field-contracts) ...
selector-codes ...
mutator-codes ...
predicate-code
constructor-code)))))
constructor-code
(provide struct-name))))))
;; build-constructor-contract : (listof syntax) syntax -> syntax
(define (build-constructor-contract field-contract-ids predicate-id)

15
collects/tests/mzscheme/contracts.ss
View File

@ -502,7 +502,7 @@
(set-s-a! (make-s 1) 2)))))
(test/spec-passed
'provide/contract4
'provide/contract5
'(let ()
(eval '(module contract-test-suite5 mzscheme
(require (lib "contracts.ss"))
@ -518,6 +518,17 @@
(make-t 1)
(t-a (make-t 1))
(t? (make-t 1))
(set-t-a! (make-t 1) 2)))))))
(set-t-a! (make-t 1) 2)))))
(test/spec-passed
'provide/contract6
'(let ()
(eval '(module contract-test-suite6 mzscheme
(require (lib "contracts.ss"))
(provide/contract (struct s ((a any?))))
(define-struct s (a))))
(eval '(require contract-test-suite6))
(eval '(define-struct (t s) ()))))
))
(report-errs)