diff --git a/collects/framework/main.ss b/collects/framework/main.ss index 78c30cac..db51e72f 100644 --- a/collects/framework/main.ss +++ b/collects/framework/main.ss @@ -1302,7 +1302,8 @@ ((text) ((start 0) (end #f))) @{Determines if the range in the editor from @scheme[start] to - @scheme[end] in @scheme[text] is a matched set of parenthesis. If + @scheme[end] in @scheme[text] has at least one complete s-expression and + there are no incomplete s-expressions. If @scheme[end] is @scheme[#f], it defaults to the last position of the @scheme[text]. diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss index 6ee835ba..4625e8c7 100644 --- a/collects/framework/private/scheme.ss +++ b/collects/framework/private/scheme.ss @@ -43,11 +43,13 @@ (let* ([end (or in-end (send text last-position))] [port (open-input-text-editor text start end)]) (with-handlers ([exn:fail:read:eof? (λ (x) #f)] - [exn:fail:read? (λ (x) #t)]) - (let loop () - (let ([s (read port)]) - (or (eof-object? s) - (loop)))))))) + [exn:fail:read? (λ (x) #f)]) + (let ([first (read port)]) + (and (not (eof-object? first)) + (let loop () + (let ([s (read port)]) + (or (eof-object? s) + (loop)))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; diff --git a/collects/tests/framework/README b/collects/tests/framework/README index f302465d..e2b5276c 100644 --- a/collects/tests/framework/README +++ b/collects/tests/framework/README @@ -71,6 +71,12 @@ signal failures when there aren't any. | These tests will make sure that the usual checks against a user | losing their work are in place. +- scheme tests: + + | Tests the scheme: section + + |# scheme.ss #| + - |# (interactive #| tests | these tests require intervention by people. Clicking and whatnot diff --git a/collects/tests/framework/scheme.ss b/collects/tests/framework/scheme.ss new file mode 100644 index 00000000..c31c5cc6 --- /dev/null +++ b/collects/tests/framework/scheme.ss @@ -0,0 +1,30 @@ +#lang scheme + +(require "test-suite-utils.ss") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; testing highlight-range method +;; + + +(define (test-text-balanced? number str start end expected) + (test + (string->symbol (format "scheme:text-balanced?-~a" number)) + (lambda (x) + (equal? x expected)) + (λ () + (send-sexp-to-mred + `(let ([t (new scheme:text%)]) + (send t insert ,str) + (scheme:text-balanced? t ,start ,end)))))) + +(test-text-balanced? 0 "" 0 #f #f) +(test-text-balanced? 1 " \n " 0 #f #f) +(test-text-balanced? 2 "foo)" 0 #f #f) +(test-text-balanced? 3 "(foo" 0 #f #f) +(test-text-balanced? 4 "(foo)" 0 #f #t) +(test-text-balanced? 5 "(foo 'bar))" 0 #f #f) +(test-text-balanced? 6 "(foo) bar ([buz])" 0 #f #t) +(test-text-balanced? 7 "(foo]" 0 #f #f) +(test-text-balanced? 8 "{foo} ((bar) [5.9])" 0 #f #t)