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

fixed PR 8293

Browse Source 
svn: r4420
This commit is contained in:
Robby Findler 2006-09-23 02:54:25 +00:00
parent 2bbad4ad12
commit 90b688b143
2 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/mzlib/private/shared-body.ss
View File

@ -146,10 +146,11 @@
[(make-x e ...) [(make-x e ...)
(struct-decl-for (syntax make-x)) (struct-decl-for (syntax make-x))
(let ([decl (struct-decl-for (syntax make-x))]) (let ([decl (struct-decl-for (syntax make-x))])
(with-syntax ([(setter ...) (reverse (list-ref decl 4))]) (syntax-case (reverse (list-ref decl 4)) ()
(syntax [()
(begin (syntax (void))]
(setter name e) ...))))] [(setter ...)
(syntax (begin (setter name e) ...))]))]
[_else (syntax (void))]))) [_else (syntax (void))])))
names exprs))] names exprs))]
[(check-expr ...) [(check-expr ...)

7
collects/tests/mzscheme/shared-tests.ss
View File

@ -27,7 +27,6 @@
(stest '#11=(#11#) '(shared ([x `(,x)]) x)) (stest '#11=(#11#) '(shared ([x `(,x)]) x))
(define-struct s (a b)) (define-struct s (a b))
(shared ([x (make-s 17 x)]) (shared ([x (make-s 17 x)])
(begin (begin
@ -35,4 +34,8 @@
(test 17 s-a x) (test 17 s-a x)
(test #t eq? x (s-b x)))) (test #t eq? x (s-b x))))
(define-struct shared-test-ds-no-fields ())
(stest (make-shared-test-ds-no-fields)
'(shared ((-4- 11)
(-8- (make-shared-test-ds-no-fields)))
-8-))