[racket-dev] Closes PR 11062

Right. It should be fixed now, tho.

Thanks,
Robby

On Fri, Jul 30, 2010 at 10:06 PM, Matthias Felleisen
<matthias at ccs.neu.edu> wrote:
>
> 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, mflatt at 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 <mflatt at 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
>