623 lines
28 KiB
Racket
623 lines
28 KiB
Racket
#lang racket/base
|
|
|
|
(require "test-suite-utils.rkt"
|
|
(for-syntax racket/base))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;; testing inserting parens and the automatic-parens prefs
|
|
;;
|
|
|
|
(define (test-type-string/proc line to-type expected-result [control-down #f])
|
|
(test
|
|
(string->symbol (format "test-type-string line ~a" line))
|
|
(λ (x) (equal? x expected-result))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let ()
|
|
(define f (new frame:basic% [label ""]))
|
|
(define t (new racket:text%))
|
|
(define ec (new canvas:basic%
|
|
[parent (send f get-area-container)]
|
|
[editor t]))
|
|
(send t on-char (new key-event% [key-code ,to-type] [control-down ,control-down]))
|
|
(send t get-text))))))
|
|
|
|
(define-syntax (test-type-string stx)
|
|
(syntax-case stx ()
|
|
[(_ . rst)
|
|
(with-syntax ([line (syntax-line stx)])
|
|
#'(test-type-string/proc line . rst))]))
|
|
|
|
(begin
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-parens #f))
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #f))
|
|
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
|
|
(test-type-string #\( "(")
|
|
(test-type-string #\[ "[")
|
|
(test-type-string #\" "\"")
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #t))
|
|
(test-type-string #\( "()")
|
|
(test-type-string #\[ "[]")
|
|
(test-type-string #\" "\"\""))
|
|
|
|
|
|
(begin
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-parens #f))
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #t))
|
|
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
|
|
(test-type-string #\( "(")
|
|
(test-type-string #\[ "(")
|
|
(test-type-string #\[ "[" #t)
|
|
(test-type-string #\" "\"")
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #t))
|
|
(test-type-string #\( "()")
|
|
(test-type-string #\[ "()")
|
|
(test-type-string #\[ "[]" #t)
|
|
(test-type-string #\" "\"\""))
|
|
|
|
(begin
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-parens #t))
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #f))
|
|
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
|
|
(test-type-string #\( "(")
|
|
(test-type-string #\[ "[")
|
|
(test-type-string #\" "\"")
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #t))
|
|
(test-type-string #\( "()")
|
|
(test-type-string #\[ "[]")
|
|
(test-type-string #\" "\"\""))
|
|
|
|
(begin
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-parens #t))
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #t))
|
|
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
|
|
(test-type-string #\( "(")
|
|
(test-type-string #\[ "(")
|
|
(test-type-string #\" "\"")
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #t))
|
|
(test-type-string #\( "()")
|
|
(test-type-string #\[ "()")
|
|
(test-type-string #\" "\"\""))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;; testing highlight-range method
|
|
;;
|
|
|
|
|
|
(define (test-text-balanced? number str start end expected)
|
|
(test
|
|
(string->symbol (format "racket:text-balanced?-~a" number))
|
|
(lambda (x)
|
|
(equal? x expected))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let ([t (new racket:text%)])
|
|
(send t insert ,str)
|
|
(racket: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 #t)
|
|
(test-text-balanced? 3 "(foo" 0 #f #f)
|
|
(test-text-balanced? 4 "(foo)" 0 #f #t)
|
|
(test-text-balanced? 5 "(foo 'bar))" 0 #f #t)
|
|
(test-text-balanced? 6 "(foo) bar ([buz])" 0 #f #t)
|
|
(test-text-balanced? 7 "(foo]" 0 #f #t)
|
|
(test-text-balanced? 8 "{foo} ((bar) [5.9])" 0 #f #t)
|
|
(test-text-balanced? 9 "#(1 2 . 3)" 0 #f #t)
|
|
|
|
(define-syntax (test-indentation stx)
|
|
(syntax-case stx ()
|
|
[(_ . args)
|
|
(with-syntax ([line (syntax-line stx)])
|
|
#'(test-indentation/proc line . args))]))
|
|
|
|
(define (test-indentation/proc line before after)
|
|
(test
|
|
(string->symbol (format "racket:test-indentation-line-~a" line))
|
|
(λ (x) (equal? x after))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let* ([t (new racket:text%)]
|
|
[f (new frame% [label ""] [width 600] [height 600])]
|
|
[ec (new editor-canvas% [parent f] [editor t])])
|
|
(send f reflow-container)
|
|
(send t insert ,before)
|
|
(send t tabify-all)
|
|
(send t get-text))))))
|
|
|
|
(test-indentation "a" "a")
|
|
(test-indentation "(a\n b)" "(a\n b)")
|
|
(test-indentation "(a\nb)" "(a\n b)")
|
|
(test-indentation "(a b\nc)" "(a b\n c)")
|
|
(test-indentation "(a ...\nb)" "(a ...\n b)")
|
|
(test-indentation "(lambda (x)\nb)" "(lambda (x)\n b)")
|
|
(test-indentation "(lambdaa (x)\nb)" "(lambdaa (x)\n b)")
|
|
(test-indentation "(define x\n (let/ec return\n (when 1\n (when 2\n\t\t 3))\n 2))"
|
|
"(define x\n (let/ec return\n (when 1\n (when 2\n 3))\n 2))")
|
|
(test-indentation "(for ([x 1])\nx)"
|
|
"(for ([x 1])\n x)")
|
|
(test-indentation "(for/list ([x 1])\nx)"
|
|
"(for/list ([x 1])\n x)")
|
|
(test-indentation "(for/anything ([x 1])\nx)"
|
|
"(for/anything ([x 1])\n x)")
|
|
(test-indentation "(for*/anything ([x 1])\nx)"
|
|
"(for*/anything ([x 1])\n x)")
|
|
(test-indentation "(for-anything ([x 1])\nx)"
|
|
"(for-anything ([x 1])\n x)")
|
|
(test-indentation "(for/fold ([x 1])\n([y 2])\n3\n4)"
|
|
"(for/fold ([x 1])\n ([y 2])\n 3\n 4)")
|
|
(test-indentation "a\na\na\n" "a\na\na\n")
|
|
(test-indentation "(begin\n1)" "(begin\n 1)")
|
|
(test-indentation "(lambda\n(x) x)" "(lambda\n (x) x)")
|
|
(test-indentation "(some-random-function x\nx)"
|
|
"(some-random-function x\n x)")
|
|
(test-indentation "(some-random-function x y\nx)"
|
|
"(some-random-function x y\n x)")
|
|
(test-indentation "(x ...\nx)"
|
|
"(x ...\n x)")
|
|
(test-indentation "(x\n;;; hello\ny)"
|
|
"(x\n ;;; hello\n y)")
|
|
(test-indentation "(require racket/contract\nracket/unit\nracket/class"
|
|
"(require racket/contract\n racket/unit\n racket/class")
|
|
(test-indentation "(r a\nb\nc\nd\ne\nf\ng"
|
|
"(r a\n b\n c\n d\n e\n f\n g")
|
|
(test-indentation "(r a b\nc d\ne f\ng h"
|
|
"(r a b\n c d\n e f\n g h")
|
|
|
|
|
|
(define (test-magic-square-bracket which before after)
|
|
(test
|
|
(string->symbol (format "racket:test-magic-square-bracket-~a" which))
|
|
(λ (x) (equal? x after))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let* ([t (new racket:text%)]
|
|
[f (new frame% [label ""] [width 600] [height 600])]
|
|
[ec (new editor-canvas% [parent f] [editor t])])
|
|
(send f reflow-container)
|
|
(send t insert ,before)
|
|
(send (racket:get-keymap) call-function "maybe-insert-[]-pair-maybe-fixup-[]" t (new event%))
|
|
(send t get-text))))))
|
|
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #t))
|
|
(test-magic-square-bracket 'mt "" "(")
|
|
(test-magic-square-bracket 'mt2 "(() " "(() (")
|
|
(test-magic-square-bracket 'mt3 "([] " "([] [")
|
|
(test-magic-square-bracket 'mt4 "(\"" "(\"[")
|
|
(test-magic-square-bracket 'mt4 "(#\\" "(#\\[")
|
|
(test-magic-square-bracket 'let1 "(let " "(let (")
|
|
(test-magic-square-bracket 'let2 "(let (" "(let ([")
|
|
(test-magic-square-bracket 'let3 "(let loop " "(let loop (")
|
|
(test-magic-square-bracket 'let3 "(let loop (" "(let loop ([")
|
|
(test-magic-square-bracket 'let4 "(let rec (" "(let rec ([")
|
|
(test-magic-square-bracket 'cond1 "(cond " "(cond [")
|
|
(test-magic-square-bracket 'cond2 "(cond [" "(cond [(")
|
|
(test-magic-square-bracket 'with-syntax1 "(syntax-case x " "(syntax-case x (")
|
|
(test-magic-square-bracket 'with-syntax2 "(syntax-case x () " "(syntax-case x () [")
|
|
(test-magic-square-bracket 'with-syntax3 "(syntax-case 'x " "(syntax-case 'x (")
|
|
(test-magic-square-bracket 'with-syntax4 "(syntax-case 'x () " "(syntax-case 'x () [")
|
|
(test-magic-square-bracket 'with-syntax3 "(syntax-case #'x " "(syntax-case #'x (")
|
|
(test-magic-square-bracket 'with-syntax4 "(syntax-case #'x () " "(syntax-case #'x () [")
|
|
(test-magic-square-bracket 'local1 "(local " "(local [")
|
|
(test-magic-square-bracket 'local2 "(local [" "(local [(")
|
|
(test-magic-square-bracket 'local2 "(local [(define x 1)] " "(local [(define x 1)] (")
|
|
(test-magic-square-bracket 'for/fold1 "(for/fold (" "(for/fold ([")
|
|
(test-magic-square-bracket 'for/fold2 "(for/fold ([x 1]) (" "(for/fold ([x 1]) ([")
|
|
|
|
(define (test-insert-return/proc line before-txt before-pos after-txt after-pos #:tabify? [tabify? #t])
|
|
(test
|
|
(string->symbol (format "racket:test-insert-return ~a" line))
|
|
(λ (x)
|
|
(and (equal? (car x) after-pos)
|
|
(equal? (cadr x) after-txt)))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let ()
|
|
(define t (new (class racket:text%
|
|
(define/override (tabify-on-return?) ,tabify?)
|
|
(super-new))))
|
|
(send t insert ,before-txt)
|
|
(send t set-position ,before-pos)
|
|
(send t insert-return)
|
|
(list (send t get-start-position)
|
|
(send t get-text)))))))
|
|
|
|
(define-syntax (test-insert-return stx)
|
|
(syntax-case stx ()
|
|
[(_ before-txt before-pos after-txt after-pos . args)
|
|
(with-syntax ([line (syntax-line stx)])
|
|
#'(test-insert-return/proc line before-txt before-pos after-txt after-pos . args))]))
|
|
|
|
(test-insert-return "" 0 "\n" 1)
|
|
(test-insert-return "" 0 "\n" 1 #:tabify? #f)
|
|
(test-insert-return " " 1 "\n" 1)
|
|
(test-insert-return " " 1 "\n" 1 #:tabify? #f)
|
|
(test-insert-return "( " 2 "(\n " 3)
|
|
(test-insert-return "( " 2 "(\n" 2 #:tabify? #f)
|
|
(test-insert-return "hellothere" 5 "hello\nthere" 6)
|
|
(test-insert-return "hellothere" 5 "hello\nthere" 6 #:tabify? #f)
|
|
(test-insert-return "#lang racket\n(+ 123 456)\n 4" 20 "#lang racket\n(+ 123\n 456)\n 4" 22)
|
|
(test-insert-return "#lang racket\n(+ 123 456)\n 4" 20 "#lang racket\n(+ 123\n456)\n 4" 20 #:tabify? #f)
|
|
(test-insert-return "#lang racket\n(+ 123 456)\n 4" 22 "#lang racket\n(+ 123\n 456)\n 4" 22)
|
|
(test-insert-return "#lang racket\n(+ 123 456)\n 4" 22 "#lang racket\n(+ 123\n 456)\n 4" 20 #:tabify? #f)
|
|
(test-insert-return "#lang racket\n(+ 123 \n 456)\n 4" 22 "#lang racket\n(+ 123 \n\n 456)\n 4" 24)
|
|
(test-insert-return "#lang racket\n(+ 123 \n 456)\n 4" 22 "#lang racket\n(+ 123 \n\n 456)\n 4" 22 #:tabify? #f)
|
|
|
|
(define (test-message-send/proc line before expected pos msg
|
|
#:check-result? [check-result? #f]
|
|
. args)
|
|
(define (maybe-quote x)
|
|
(cond
|
|
[(or (number? x) (boolean? x) (string? x)) x]
|
|
[else `',x]))
|
|
(test
|
|
(string->symbol (format "line ~a: ~s"
|
|
line
|
|
`(,msg ,@(map maybe-quote args))))
|
|
(λ (x) (equal? x expected))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let ()
|
|
(define f (new frame% [label ""]))
|
|
(define t (new racket:text%))
|
|
(define ec (new editor-canvas% [parent f] [editor t]))
|
|
(send t insert ,before)
|
|
(send t set-position ,pos)
|
|
(define ans (send t ,msg ,@(map maybe-quote args)))
|
|
,(if check-result?
|
|
'ans
|
|
'(send t get-text)))))))
|
|
(define-syntax (test-message-send stx)
|
|
(syntax-case stx ()
|
|
[(_ before expected pos mth . args)
|
|
(with-syntax ([line (syntax-line stx)])
|
|
#'(test-message-send/proc line before expected pos 'mth . args))]))
|
|
|
|
(test-message-send "" "]" 0 insert-close-paren 0 #\] #t #t 'adjacent)
|
|
(test-message-send "" "]" 0 insert-close-paren 0 #\] #t #t #f)
|
|
(test-message-send "(" "()" 1 insert-close-paren 1 #\] #t #t #f)
|
|
(test-message-send "(" "(]" 1 insert-close-paren 1 #\] #f #f #f)
|
|
(test-message-send "" "]" 0 insert-close-paren 0 #\] #t #t 'forward)
|
|
|
|
(test-message-send "(1)" "1" 1 kill-enclosing-parens 1)
|
|
(test-message-send "(1 2 3)" "1 2 3" 3 kill-enclosing-parens 3)
|
|
(test-message-send "()" "" 1 kill-enclosing-parens 1)
|
|
(test-message-send "(1\n 2\n 3)" "1\n2\n3" 1 kill-enclosing-parens 1) ;; test tabify call
|
|
|
|
(test-message-send "abc" #f 1 backward-containing-sexp #:check-result? #t 1 3)
|
|
|
|
;; tests what happens when a given key/s is/are typed in an editor with initial
|
|
;; text and cursor position, under different settings of the auto-parentheses and
|
|
;; smart-skip-parentheses preferences .nah.
|
|
|
|
;; test-auto-parens-behavior
|
|
;; : any string
|
|
;; [or num (list num num)] [or char symbol 1string (list char) (list key-event%)]
|
|
;; [or num (list num num)] string
|
|
(define (test-auto-parens-behavior which initial-text initial-pos keys final-text final-pos
|
|
[auto-parens? #f])
|
|
(test
|
|
(string->symbol (format "racket:test-auto-parens-behavior ~a" which))
|
|
(λ (x) (if (list? final-pos)
|
|
(equal? x (list (car final-pos) (cadr final-pos) final-text))
|
|
(equal? x (list final-pos final-pos final-text))))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let* ([t (new racket:text%)]
|
|
[f (new frame% [label ""] [width 600] [height 600])]
|
|
[ec (new editor-canvas% [parent f] [editor t])])
|
|
(preferences:set 'framework:fixup-parens #t)
|
|
(preferences:set 'framework:automatic-parens ,auto-parens?)
|
|
(send f reflow-container)
|
|
(send t insert ,initial-text)
|
|
,(if (number? initial-pos)
|
|
`(send t set-position ,initial-pos)
|
|
`(send t set-position ,(car initial-pos) ,(cadr initial-pos)))
|
|
,@(map
|
|
(lambda (k)
|
|
(cond [(char? k)
|
|
`(send (racket:get-keymap)
|
|
handle-key-event t (new key-event% [key-code ,k]))]
|
|
[(string? k)
|
|
`(send (racket:get-keymap)
|
|
handle-key-event t (new key-event% [key-code ,(car (string->list k))]))]
|
|
[(symbol? k)
|
|
`(send (racket:get-keymap)
|
|
handle-key-event t (new key-event% [key-code (quote ,k)]))]
|
|
[else `(send (racket:get-keymap) handle-key-event t ,k)]))
|
|
(if (list? keys) keys (list keys)))
|
|
(list (send t get-start-position) (send t get-end-position) (send t get-text)))))))
|
|
|
|
|
|
;; this takes an initial editor state (specified by the text before the cursor,
|
|
;; some selected text (may be blank string), and text after the cursor), and
|
|
;; a key(s), and runs tests to check what happens when that key(s) is/are
|
|
;; typed - in both possible settings of the 'automatic-parens preference
|
|
;;
|
|
;; final-states is a list of 2-pairs of strings. each pair is the final text before
|
|
;; and after the cursor, for auto-parens disabled and enabled respectively
|
|
;; (NB. final-states could also contain 3-pairs of strings, the middle portion
|
|
;; representing text that is selected after the insertion)
|
|
(define (test-parens-behavior/full which
|
|
init-text-before init-text-selected init-text-after
|
|
keys
|
|
final-states)
|
|
(define initial-text (string-append init-text-before init-text-selected init-text-after))
|
|
(define initial-start-pos (string-length init-text-before))
|
|
(define initial-end-pos (+ initial-start-pos (string-length init-text-selected)))
|
|
(for-each
|
|
(lambda (label auto? final-pair)
|
|
(test-auto-parens-behavior (format "~a (~a)" which label)
|
|
initial-text (list initial-start-pos initial-end-pos) keys
|
|
(apply string-append final-pair)
|
|
(if (= 3 (length final-pair))
|
|
; final-pair could actually be a triplet
|
|
; to indicate residual selection after insertion
|
|
(list (string-length (car final-pair))
|
|
(string-length (string-append (car final-pair)
|
|
(cadr final-pair))))
|
|
(string-length (car final-pair)))
|
|
auto?))
|
|
'("no-auto-parens" "with-auto-parens")
|
|
'(#f #t)
|
|
final-states))
|
|
|
|
|
|
(define SPECIAL-CHARS '(#\( #\) #\[ #\] #\" #\| #\{ #\}))
|
|
|
|
(for ([k SPECIAL-CHARS])
|
|
;; test that character literals never result in a pair of characters typed...
|
|
(test-parens-behavior/full (format "literal-~a" k)
|
|
"(list 1 #\\" "" ")"
|
|
k
|
|
`([,(string-append "(list 1 #\\" (string k)) ")"]
|
|
[,(string-append "(list 1 #\\" (string k)) ")"]))
|
|
;; test that escaped characters in a string never result in a pair of characters typed...
|
|
;; except for | which is a hard case to detect, because the tokenizer ends up
|
|
;; in an error state
|
|
(unless (or (eq? #\| k))
|
|
(test-parens-behavior/full (format "literal-~a-in-string" k)
|
|
"\"abc \\" "" "def\""
|
|
k
|
|
`([,(string-append "\"abc \\" (string k)) "def\""]
|
|
[,(string-append "\"abc \\" (string k)) "def\""])))
|
|
;; test that auto-parens has no effect in strings, *except for double quotes*
|
|
(unless (eq? #\" k)
|
|
(test-parens-behavior/full (format "~a-in-string" k)
|
|
"\" abc def " "" " \""
|
|
k
|
|
`([,(string-append "\" abc def " (string k)) " \""]
|
|
[,(string-append "\" abc def " (string k)) " \""])))
|
|
|
|
;; test that auto-parens has no effect in various comment situations
|
|
(define scenarios
|
|
; description before-cursor after-cursor
|
|
'(("in-line-comment" ";; abc def " " ghi ")
|
|
("end-of-line-comment" ";; abc def " "")
|
|
("end-of-line-comment-with-close-paren" ";; abc def " " ) \n )")
|
|
("in-block-comment" "#| abc def " " ghi |#")
|
|
))
|
|
(for ([s scenarios])
|
|
(let* ([before (cadr s)]
|
|
[after (caddr s)]
|
|
[before-final (string-append before (string k))]
|
|
[result (list before-final after)])
|
|
(test-parens-behavior/full (format "~a-~a" k (car s))
|
|
before "" after k `(,result ,result)))))
|
|
|
|
;;; assorted other scenarios...
|
|
(test-parens-behavior/full 'open-parens
|
|
"abcd" "" "efg" ; editor state: before, selected, after
|
|
#\( ; key(s) pressed
|
|
'(["abcd(" "efg"] ; result state sep by cursor, no auto-parens
|
|
["abcd(" ")efg"])) ; result state with auto-parens
|
|
|
|
(test-parens-behavior/full 'close-1
|
|
"abcd" "" "efg"
|
|
#\)
|
|
'(["abcd)" "efg"] ["abcd)" "efg"]))
|
|
(test-parens-behavior/full 'close-2
|
|
"(abcd" "" "efg"
|
|
#\)
|
|
'(["(abcd)" "efg"] ["(abcd)" "efg"]))
|
|
(test-parens-behavior/full 'close-3
|
|
"(abcd" "" ")efg"
|
|
#\)
|
|
'(["(abcd)" ")efg"] ["(abcd)" "efg"]))
|
|
(test-parens-behavior/full 'close-4
|
|
"(abcd efg " "" " ) efg"
|
|
#\)
|
|
'(["(abcd efg )" " ) efg"]
|
|
["(abcd efg )" " efg"]))
|
|
(test-parens-behavior/full 'close-5
|
|
"(define before+afters `([\"\" abc \"efg\" 12345 xyz]) [84])"
|
|
""
|
|
""
|
|
#\)
|
|
'(["(define before+afters `([\"\" abc \"efg\" 12345 xyz]) [84]))" ""]
|
|
["(define before+afters `([\"\" abc \"efg\" 12345 xyz]) [84]))" ""]))
|
|
(test-parens-behavior/full 'close-6
|
|
"(define before+afters `([\"\" abc \"efg\""
|
|
""
|
|
" 12345 xyz]) [84])"
|
|
#\)
|
|
'(["(define before+afters `([\"\" abc \"efg\"]" " 12345 xyz]) [84])"]
|
|
["(define before+afters `([\"\" abc \"efg\"]" " 12345 xyz]) [84])"]))
|
|
|
|
|
|
(test-parens-behavior/full 'close-skip-1
|
|
"(define before+afters `([\"\" abc \"efg\" 12345 xyz]"
|
|
""
|
|
" ) [84])"
|
|
#\)
|
|
'(["(define before+afters `([\"\" abc \"efg\" 12345 xyz])" " ) [84])"]
|
|
["(define before+afters `([\"\" abc \"efg\" 12345 xyz] )" " [84])"]))
|
|
(test-parens-behavior/full 'close-skip-fixup-1
|
|
"(define before+afters `{[abc 123]"
|
|
""
|
|
" ) [84])"
|
|
#\) ; here the next close after ) doesn't match the {, so no skip happens
|
|
'(["(define before+afters `{[abc 123]}" " ) [84])"]
|
|
["(define before+afters `{[abc 123]}" " ) [84])"]))
|
|
(test-parens-behavior/full 'close-skip-fixup-2
|
|
"(define before+afters `{[abc 123]"
|
|
""
|
|
" } [84])"
|
|
#\) ; here the next close does match the {, so skip
|
|
'(["(define before+afters `{[abc 123]}" " } [84])"]
|
|
["(define before+afters `{[abc 123] }" " [84])"]))
|
|
|
|
(test-parens-behavior/full 'surround-open-1
|
|
"abcd" "ef" "g"
|
|
#\(
|
|
'(["abcd(" "g"] ["abcd(" "ef)g"]))
|
|
|
|
(test-parens-behavior/full 'double-quote-1
|
|
"" "" ""
|
|
#\"
|
|
'(["\"" ""] ["\"" "\""]))
|
|
(test-parens-behavior/full 'double-quote-2
|
|
"abc " "" ""
|
|
#\"
|
|
'(["abc \"" ""] ["abc \"" "\""]))
|
|
(test-parens-behavior/full 'double-quote-selection-1
|
|
"(abc " "def 123" " xyz]"
|
|
#\"
|
|
'(["(abc \"" " xyz]"] ["(abc \"" "def 123\" xyz]"]))
|
|
(test-parens-behavior/full 'double-quote-skip-1
|
|
"\"abc def " "" "\" 123"
|
|
#\"
|
|
'(["\"abc def \"" "\" 123"] ["\"abc def \"" " 123"]))
|
|
(test-parens-behavior/full 'double-quote-escaped-1
|
|
"\"abcd \\" "" ""
|
|
#\"
|
|
'(["\"abcd \\\"" ""]
|
|
["\"abcd \\\"" "\""])) ; this inserts double since string was not closed
|
|
(test-parens-behavior/full 'double-quote-escaped-2
|
|
"\"abcd \\" "" "\""
|
|
#\"
|
|
'(["\"abcd \\\"" "\""]
|
|
["\"abcd \\\"" "\""]))
|
|
|
|
(test-parens-behavior/full 'bar
|
|
"abc " "" "123"
|
|
#\|
|
|
'(["abc |" "123"] ["abc |" "|123"]))
|
|
(test-parens-behavior/full 'bar-literal
|
|
"(list 1 #\\" "" ")"
|
|
#\|
|
|
'(["(list 1 #\\|" ")"] ["(list 1 #\\|" ")"]))
|
|
(test-parens-behavior/full 'bar-skip
|
|
"abc |def" "" "|123"
|
|
#\|
|
|
'(["abc |def|" "|123"] ["abc |def|" "123"]))
|
|
(test-parens-behavior/full 'bar-selection
|
|
"abc |def " "hij" "|123"
|
|
#\|
|
|
'(["abc |def |" "|123"] ["abc |def |" "hij||123"]))
|
|
|
|
|
|
(test-parens-behavior/full 'block-comment-1
|
|
" #" "" ""
|
|
#\|
|
|
'([" #|" ""]
|
|
[" #|" "|#"]))
|
|
(test-parens-behavior/full 'block-comment-2
|
|
"(123 abc#" "" " def 456)"
|
|
#\|
|
|
'(["(123 abc#|" " def 456)"]
|
|
["(123 abc#|" "|# def 456)"]))
|
|
(test-parens-behavior/full 'block-comment-skip-1
|
|
"#| (123 abc" "" "|# def 456)"
|
|
#\|
|
|
'(["#| (123 abc|" "|# def 456)"]
|
|
["#| (123 abc|#" " def 456)"]))
|
|
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-space-follows-paren
|
|
"( x" "" ""
|
|
#\]
|
|
'(["( x)" "" ""]
|
|
["( x)" "" ""]))
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-inside-a-comment
|
|
"[();" "" ""
|
|
#\)
|
|
'(["[();)" "" ""]
|
|
["[();)" "" ""]))
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-inside-a-comment.2
|
|
"[;" "" "\n"
|
|
#\)
|
|
'(["[;)" "" "\n"]
|
|
["[;)" "" "\n"]))
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-inside-an-unclosed-string
|
|
"[()\"" "" ""
|
|
#\)
|
|
'(["[()\")" "" ""]
|
|
["[()\")" "" ""]))
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-inside-a-string
|
|
"[()\"" "" "\""
|
|
#\)
|
|
'(["[()\")" "" "\""]
|
|
["[()\")" "" "\""]))
|
|
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-no-containing-sexp
|
|
")" "" ""
|
|
#\]
|
|
'([")]" "" ""]
|
|
[")]" "" ""]))
|
|
|
|
(test-parens-behavior/full '|"-splits-string|
|
|
" \"abcd" "" "efg\" "
|
|
#\"
|
|
'([" \"abcd\"" "efg\" "]
|
|
[" \"abcd\" " "\"efg\" "]))
|
|
(test-parens-behavior/full '|"-splits-string-at-beginning|
|
|
" \"" "" "abcdefg\" "
|
|
#\"
|
|
'([" \"\"" "abcdefg\" "]
|
|
[" \"\" " "\"abcdefg\" "]))
|
|
(test-parens-behavior/full '|"-splits-out-selected-string|
|
|
" \"abc" "def" "ghi\" "
|
|
#\"
|
|
'([" \"abc\"" "" "ghi\" "]
|
|
; test that "def" remains selected afterwards...
|
|
[" \"abc\" " "\"def\"" " \"ghi\" "]))
|
|
|
|
|
|
|
|
#| for these, the key-event with meta-down doesn't seem to work... maybe a Mac OS
|
|
issue; and may cause problems with these tests on another platform? .nah. |#
|
|
(when (equal? 'macosx (system-type))
|
|
(test-parens-behavior/full 'meta-open-1
|
|
"abcd" "" "efg"
|
|
'(escape #\() ; '((new key-event% [key-code #\(] [meta-down #t]))
|
|
'(["abcd(" ")efg"] ["abcd(" ")efg"]))
|
|
|
|
(test-parens-behavior/full 'meta-close-skip-1
|
|
"(define before (list 1 2" "" " 3 4)"
|
|
'(escape #\)) ; '((new key-event% [key-code #\)] [meta-down #t]))
|
|
'(["(define before (list 1 2 3 4)" ""]
|
|
["(define before (list 1 2 3 4)" ""]))
|
|
(test-parens-behavior/full
|
|
'meta-close-skip-2
|
|
"#lang racket\n(define before+afters `([\"\" abc \"efg\""
|
|
""
|
|
" 12345 xyz] [84])"
|
|
'(escape #\)) ;'((new key-event% [key-code #\)] [meta-down #t]))
|
|
'(["#lang racket\n(define before+afters `([\"\" abc \"efg\" 12345 xyz]" " [84])"]
|
|
["#lang racket\n(define before+afters `([\"\" abc \"efg\" 12345 xyz]" " [84])"]))
|
|
(test-parens-behavior/full 'meta-close-skip-3
|
|
"(define before" "" " (list 1 2 3 4)"
|
|
'(escape #\)) ; '((new key-event% [key-code #\)] [meta-down #t]))
|
|
'(["(define before (list 1 2 3 4)" ""]
|
|
["(define before (list 1 2 3 4)" ""])))
|
|
|