Better output for procedures that failed property checks.

svn: r16039
This commit is contained in:
Mike Sperber 2009-09-17 13:05:12 +00:00
parent f3676a152b
commit e5df901306
2 changed files with 9 additions and 2 deletions

View File

@ -880,7 +880,7 @@
(define true (contract (one-of #f)))
(define false (contract (one-of #f)))
(define string (contract/arbitrary arbitrary-string (predicate string?)))
(define string (contract/arbitrary arbitrary-printable-ascii-string (predicate string?)))
(define symbol (contract/arbitrary arbitrary-symbol (predicate symbol?)))
(define empty-list (contract (one-of empty)))

View File

@ -54,6 +54,9 @@
(define user-installed-teachpacks-collection "installed-teachpacks")
(define teachpack-installation-dir (build-path (find-user-collects-dir) user-installed-teachpacks-collection))
(define generic-proc
(procedure-rename void '?))
;; adapted from collects/drscheme/private/main.ss
(preferences:set-default 'drscheme:deinprogramm:last-set-teachpacks
'()
@ -205,7 +208,11 @@
obj contract message blame))))))
(scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace contract-test-display%))
(test-execute (get-preference 'tests:enable? (lambda () #t)))
(test-format (make-formatter (lambda (v o) (render-value/format v settings o 40))))
(test-format (make-formatter (lambda (v o)
(render-value/format (if (procedure? v)
generic-proc
v)
settings o 40))))
)))
(super on-execute settings run-in-user-thread)