From 2556c61f9d818ad09d2264d56adb49b3ee4c3177 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 16 Mar 2009 12:06:17 +0000 Subject: [PATCH] PR 10078 -- NOT for inclusion in the release svn: r14122 --- collects/scheme/private/contract-guts.ss | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/collects/scheme/private/contract-guts.ss b/collects/scheme/private/contract-guts.ss index b998a7521e..2e84a67a27 100644 --- a/collects/scheme/private/contract-guts.ss +++ b/collects/scheme/private/contract-guts.ss @@ -356,7 +356,9 @@ (define (flat-contract predicate) (coerce-flat-contract 'flat-contract predicate)) (define (check-flat-named-contract predicate) (coerce-flat-contract 'flat-named-contract predicate)) (define (flat-named-contract name predicate) - (coerce-flat-contract 'flat-named-contract predicate) + (unless (and (procedure? predicate) + (procedure-arity-includes? predicate 1)) + (error 'flat-named-contract "expected a procedure of arity 1 as second argument, got ~e" predicate)) (make-predicate-contract name predicate)) ;; build-compound-type-name : (union contract symbol) ... -> (-> sexp)