diff --git a/collects/drscheme/syncheck.ss b/collects/drscheme/syncheck.ss index a8493ec56d..2c5bc8d83d 100644 --- a/collects/drscheme/syncheck.ss +++ b/collects/drscheme/syncheck.ss @@ -2295,7 +2295,9 @@ If the namespace does not, they are colored the unbound color. ;; colors the syntax with style-name's style (define (color source-editor-cache stx style-name) (let ([source (find-source-editor source-editor-cache stx)]) - (when (is-a? source text%) + (when (and (is-a? source text%) + (syntax-position stx) + (syntax-span stx)) (let ([pos (- (syntax-position stx) 1)] [span (syntax-span stx)]) (color-range source pos (+ pos span) style-name))))) diff --git a/collects/scheme/private/contract-arrow.ss b/collects/scheme/private/contract-arrow.ss index 61f4ef2ff9..74daaafee1 100644 --- a/collects/scheme/private/contract-arrow.ss +++ b/collects/scheme/private/contract-arrow.ss @@ -899,15 +899,7 @@ v4 todo: (cond [(not rng) #f] [(box? rng) - (map (λ (val) - (keyword-apply - val - kwd-args - kwd-arg-vals - (append - ;; this parameter (if necc.) - (if (->d-mtd? ->d-stct) (list (car raw-orig-args)) '()) - orig-args))) + (map (λ (val) (apply val dep-pre-args)) (unbox rng))] [else rng]))] [rng-underscore? (box? (->d-range ->d-stct))]) diff --git a/collects/tests/drscheme/syncheck-test.ss b/collects/tests/drscheme/syncheck-test.ss index a3a72dd085..97821a0fc1 100644 --- a/collects/tests/drscheme/syncheck-test.ss +++ b/collects/tests/drscheme/syncheck-test.ss @@ -829,7 +829,7 @@ #f))) (define (run-test) - (check-language-level #rx"Graphical") + (check-language-level #rx"Pretty") (let* ([drs (wait-for-drscheme-frame)] [defs (send drs get-definitions-text)] [filename (make-temporary-file "syncheck-test~a")]) diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index 9bbd720268..918de1dd6f 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -1642,6 +1642,22 @@ x) '(ctc body)) + (test/spec-passed/result + '->d-underscore4 + '((contract (->d ([str any/c]) () #:rest rest (listof any/c) [_ any/c]) + (λ (x . y) (cons x y)) + 'pos 'neg) + 1 2 3) + '(1 2 3)) + + (test/spec-passed/result + '->d-underscore5 + '((contract (->d ([str any/c]) () #:rest rest (listof any/c) [_ any/c]) + (λ (x . y) (cons x y)) + 'pos 'neg) + 1 2 3 4 5) + '(1 2 3 4 5)) + ; ; ;