[CS] struct-type-make-predicate creates a value that passes struct-predicate-procedure?

Fixes #3239
This commit is contained in:
Fred Fu 2020-06-08 17:03:17 -04:00 committed by GitHub
parent cd996c3b6c
commit c2cae5b7e3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 7 additions and 2 deletions

View File

@ -70,7 +70,12 @@
(test #f struct-accessor-procedure? set1) (test #f struct-accessor-procedure? set1)
(err/rt-test (make-struct-field-accessor sel 3) exn:application:mismatch?) (err/rt-test (make-struct-field-accessor sel 3) exn:application:mismatch?)
(test 'make-a object-name (struct-type-make-constructor type)) (test 'make-a object-name (struct-type-make-constructor type))
(test 'some-other-name object-name (struct-type-make-constructor type 'some-other-name)) (let ([new-ctor (struct-type-make-constructor type 'some-other-name)])
(test 'some-other-name object-name new-ctor)
(test #t struct-constructor-procedure? new-ctor))
(let ([new-pred (struct-type-make-predicate type)])
(test #t struct-predicate-procedure? new-pred)
(test #f struct-constructor-procedure? new-pred))
(let ([an-a (make 'one 'two)] (let ([an-a (make 'one 'two)]
[an-ax (makex)]) [an-ax (makex)])
(test #f procedure-struct-type? type) (test #f procedure-struct-type? type)

View File

@ -945,7 +945,7 @@
(or (record? v rtd*) (or (record? v rtd*)
(and (impersonator? v) (and (impersonator? v)
(record? (impersonator-val v) rtd*)))))]) (record? (impersonator-val v) rtd*)))))])
(register-struct-constructor! pred) (register-struct-predicate! pred)
pred))) pred)))
;; ---------------------------------------- ;; ----------------------------------------