Robby, this fix does NOT change the problematic coverage of structures. Fields are still colored as if they had never been evaluated.
On Jul 30, 2010, at 1:16 PM, mfl...@racket-lang.org wrote: > mflatt has updated `master' from 14de7399bd to 0e8af6bc5d. > http://git.racket-lang.org/plt/14de7399bd..0e8af6bc5d > > =====[ 1 Commits ]====================================================== > > Directory summary: > 93.3% collects/lang/private/ > 6.6% collects/tests/racket/ > > ~~~~~~~~~~ > > 0e8af6b Matthew Flatt <mfl...@racket-lang.org> 2010-07-30 11:04 > : > | fix acc/mut error msgs from `define-struct' in teaching languages > | Merge to 5.0.1 > | Closes PR 11062 > : > M collects/lang/private/teach.rkt | 42 ++++++++++++++++++++----------- > M collects/tests/racket/advanced.rktl | 4 +++ > M collects/tests/racket/beg-adv.rktl | 1 + > > =====[ Overall Diff ]=================================================== > > collects/lang/private/teach.rkt > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/collects/lang/private/teach.rkt > +++ NEW/collects/lang/private/teach.rkt > @@ -116,13 +116,13 @@ > (define-for-syntax (stepper-ignore-checker stx) > (stepper-syntax-property stx 'stepper-skipto '(syntax-e cdr syntax-e cdr > car))) > > - (define-for-syntax (map-with-index proc list) > - (let loop ([i 0] [list list] [rev-result '()]) > - (if (null? list) > + (define-for-syntax (map-with-index proc . lists) > + (let loop ([i 0] [lists lists] [rev-result '()]) > + (if (null? (car lists)) > (reverse rev-result) > (loop (+ 1 i) > - (cdr list) > - (cons (proc i (car list)) rev-result))))) > + (map cdr lists) > + (cons (apply proc i (map car lists)) rev-result))))) > > ;; build-struct-names is hard to handle > (define-for-syntax (make-struct-names name fields stx) > @@ -855,16 +855,28 @@ > ;; give > `check-struct-wraps!' access > > (make-inspector))) > > - #,@(map-with-index (lambda (i name) > - #`(define > (#,name r) > - > (raw-generic-access r #,i) ; error checking > - > (check-struct-wraps! r) > - > (raw-generic-access r #,i))) > - getter-names) > - #,@(map-with-index (lambda (i name) > - #`(define > (#,name r v) > - > (raw-generic-mutate r #,i v))) > - setter-names) > + #,@(map-with-index (lambda (i name > field-name) > + #`(define #,name > + (let > ([raw (make-struct-field-accessor > + > raw-generic-access > + > #,i > + > '#,field-name)]) > + > (lambda (r) > + (raw > r) ; error checking > + > (check-struct-wraps! r) > + (raw > r))))) > + getter-names > + fields) > + #,@(map-with-index (lambda (i name > field-name) > + #`(define > #,name > + (let > ([raw (make-struct-field-mutator > + > raw-generic-mutate > + > #,i > + > '#,field-name)]) > + > (lambda (r v) > + (raw > r v))))) > + setter-names > + fields) > (define #,predicate-name > raw-predicate) > (define #,constructor-name > raw-constructor) > > > collects/tests/racket/advanced.rktl > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/collects/tests/racket/advanced.rktl > +++ NEW/collects/tests/racket/advanced.rktl > @@ -285,6 +285,10 @@ > (htdp-test #t 'hash-eqv? > (hash-eqv? (make-hasheqv (list (list 'a 1))))) > > +;; Check set...! error message: > +(htdp-top (define-struct a1 (b))) > +(htdp-err/rt-test (set-a1-b! 1 2) #rx"set-a1-b!") > +(htdp-top-pop 1) > > ;; Simulate set! in the repl > (module my-advanced-module (lib "htdp-advanced.rkt" "lang") > > collects/tests/racket/beg-adv.rktl > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/collects/tests/racket/beg-adv.rktl > +++ NEW/collects/tests/racket/beg-adv.rktl > @@ -77,6 +77,7 @@ > (htdp-test #t 'a3? (a3? (make-a3 1 2 3))) > (htdp-test #f 'a1? (a1? (make-a3 1 2 3))) > (htdp-test #f 'a3? (a3? (make-a1 1))) > +(htdp-err/rt-test (a1-b 10) #rx"a1-b") > > (htdp-syntax-test #'cond) > (htdp-syntax-test #'(cond)) _________________________________________________ For list-related administrative tasks: http://lists.racket-lang.org/listinfo/dev
