parent
c7ca4414ca
commit
dbe36162ac
|
@ -207,4 +207,11 @@
|
|||
(test 'bytes-set! object-name bytes-set!)
|
||||
(test 'bytes-length object-name bytes-length)
|
||||
|
||||
;; Check some primitive structure functions
|
||||
(test 'date object-name date)
|
||||
(test 'date* object-name date*)
|
||||
(test 'date? object-name date?)
|
||||
(test 'date*? object-name date*?)
|
||||
(test 'date-second object-name date-second)
|
||||
|
||||
(report-errs)
|
||||
|
|
|
@ -1282,16 +1282,20 @@
|
|||
(define name ctr-expr)
|
||||
(define authentic-name? (record-predicate struct:name))
|
||||
(define name? (|#%struct-predicate|
|
||||
(|#%name|
|
||||
name?
|
||||
(lambda (v) (or (authentic-name? v)
|
||||
(and (impersonator? v)
|
||||
(authentic-name? (impersonator-val v)))))))
|
||||
(authentic-name? (impersonator-val v))))))))
|
||||
(define name-field
|
||||
(let ([name-field (record-accessor struct:name field-index)])
|
||||
(|#%struct-field-accessor|
|
||||
(|#%name|
|
||||
name-field
|
||||
(lambda (v)
|
||||
(if (authentic-name? v)
|
||||
(name-field v)
|
||||
(pariah (impersonate-ref name-field struct:name field-index v 'name 'field))))
|
||||
(pariah (impersonate-ref name-field struct:name field-index v 'name 'field)))))
|
||||
struct:name
|
||||
field-index)))
|
||||
...
|
||||
|
|
Loading…
Reference in New Issue
Block a user