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

Fixes build-struct-expand-info to create correct struct info.

Browse Source 
Adds a check to struct-info? to make sure selectors
and mutators are the same length. Closes PR12017.
This commit is contained in:
Eric Dobson 2011-07-02 11:22:54 -04:00 committed by Vincent St-Amour
parent a9655c04dd
commit 07910253b4
2 changed files with 14 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/racket/private/struct-info.rkt
View File

@ -103,6 +103,7 @@
(identifier/#f? (caddr x))
(id/#f-list? identifier? (list-ref x 3))
(id/#f-list? identifier/#f? (list-ref x 4))
(= (length (list-ref x 3)) (length (list-ref x 4)))
(or (eq? #t (list-ref x 5)) (identifier/#f? (list-ref x 5)))))))
(define-values (prop:struct-auto-info

24
collects/syntax/struct.rkt
View File

@ -200,25 +200,27 @@
base))]
[qs (lambda (x) (if (eq? x #t)
x
(and x `(quote-syntax ,x))))])
(and x `(quote-syntax ,x))))]
[self-sels (reverse (if omit-sel?
null
(map qs (if omit-set? flds (every-other flds)))))]
[self-sets (reverse (if omit-sel?
null
(if omit-set?
(map (lambda (sel) #f) self-sels)
(map qs (every-other (if (null? flds)
null
(cdr flds)))))))])
`(let ()
(list
,(qs (car names))
,(qs (cadr names))
,(qs (caddr names))
(list
,@(reverse (if omit-sel?
null
(map qs (if omit-set? flds (every-other flds)))))
,@self-sels
,@(map qs (add-#f omit-sel? base-getters)))
(list
,@(reverse (if omit-set?
null
(map qs (if omit-sel?
flds
(every-other (if (null? flds)
null
(cdr flds)))))))
,@self-sets
,@(map qs (add-#f omit-set? base-setters)))
,(qs base-name))))))