From 07910253b455ad4956047a2e2e31483334164c08 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 2 Jul 2011 11:22:54 -0400 Subject: [PATCH] Fixes build-struct-expand-info to create correct struct info. Adds a check to struct-info? to make sure selectors and mutators are the same length. Closes PR12017. --- collects/racket/private/struct-info.rkt | 1 + collects/syntax/struct.rkt | 24 +++++++++++++----------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/collects/racket/private/struct-info.rkt b/collects/racket/private/struct-info.rkt index c77d6275bf..aedcdfa1f1 100644 --- a/collects/racket/private/struct-info.rkt +++ b/collects/racket/private/struct-info.rkt @@ -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 diff --git a/collects/syntax/struct.rkt b/collects/syntax/struct.rkt index f6de94d8da..2773cdb0b8 100644 --- a/collects/syntax/struct.rkt +++ b/collects/syntax/struct.rkt @@ -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))))))