From 6d08558ab798a289a0e2dea3eb07fd27bd21907a Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 29 Apr 2009 21:08:01 +0000 Subject: [PATCH] fixed a bug in my earlier bugfix (also PR 10221) svn: r14662 --- collects/scheme/private/contract-arrow.ss | 9 ++++----- collects/tests/mzscheme/contract-test.ss | 3 ++- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/collects/scheme/private/contract-arrow.ss b/collects/scheme/private/contract-arrow.ss index 6de5d4e53f..74408bc4a8 100644 --- a/collects/scheme/private/contract-arrow.ss +++ b/collects/scheme/private/contract-arrow.ss @@ -837,10 +837,9 @@ v4 todo: (define (->d-proj ->d-stct) (let* ([opt-count (length (->d-optional-dom-ctcs ->d-stct))] - [mandatory-count (length (->d-mandatory-dom-ctcs ->d-stct))] - [non-kwd-ctc-count (+ mandatory-count - opt-count - (if (->d-mtd? ->d-stct) 1 0))] + [mandatory-count (+ (length (->d-mandatory-dom-ctcs ->d-stct)) + (if (->d-mtd? ->d-stct) 1 0))] + [non-kwd-ctc-count (+ mandatory-count opt-count)] [arity (cond [(->d-rest-ctc ->d-stct) @@ -988,7 +987,7 @@ v4 todo: arity (->d-mandatory-keywords ->d-stct) - (->d-optional-keywords ->d-stct)))))))) + (->d-keywords ->d-stct)))))))) ;; invoke-dep-ctc : (...? -> ctc) (or/c #f (listof tst)) val pos-blame neg-blame src-info orig-src -> tst (define (invoke-dep-ctc dep-ctc dep-args val pos-blame neg-blame src-info orig-str) diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index 3b299b5f8d..e161246738 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -1345,7 +1345,8 @@ '((contract (->d ([x number?]) () #:rest rst number? any) (λ (x . rst) (values 4 5)) 'pos - 'neg))) + 'neg) + #f)) (test/pos-blame '->d-arity1