suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: add guard for prop:arity-string

Browse Source 
Relevant to #2569
This commit is contained in:
Matthew Flatt 2019-03-29 10:59:04 -06:00
parent fdad73df32
commit 253f0f4383
2 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
pkgs/racket-test-core/tests/racket/procs.rktl
View File

@ -595,7 +595,25 @@
(write (compile '(f)) o)
(test #t 'same? (eval (parameterize ([read-accept-compiled #t])
(read (open-input-bytes (get-output-bytes o))))))))
;; ----------------------------------------
;; Check prop:arity-string
(err/rt-test (let ()
(struct a (x)
#:property prop:arity-string 'bad)
(a 0)))
(err/rt-test (let ()
(struct evens (proc)
#:property prop:procedure (struct-field-index proc)
#:property prop:arity-string
(lambda (p)
"an even number of arguments"))
((evens (lambda (x y) x)) 100))
exn:fail:contract?
#rx"an even number of arguments")
;; ----------------------------------------
(report-errs)

6
racket/src/cs/rumble/procedure.ss
View File

@ -2,7 +2,11 @@
(make-struct-type-property 'method-arity-error))
(define-values (prop:arity-string arity-string? arity-string-ref)
(make-struct-type-property 'arity-string))
(make-struct-type-property 'arity-string (lambda (v info)
(check 'guard-for-prop:arity-string
(procedure-arity-includes/c 1)
v)
v)))
(define-values (prop:procedure procedure-struct? procedure-struct-ref)
(make-struct-type-property 'procedure (lambda (v info)