updated framework test framework:

- can now test multi-key sequences

- can now use tests with 'escape

- README changed .ss to .rkt

- added test cases for c:c;c:[

collects/framework/test.rkt

@@ -466,7 +466,8 @@
         'noalt 'nocontrol 'nometa 'noshift))
 
 (define valid-key-symbols
-  (list 'start 'cancel 'clear 'shift 'control 'menu 'pause 'capital
+  (list 'escape ;; just trying this for the heck of it -- JBC, 2010-08-13
+        'start 'cancel 'clear 'shift 'control 'menu 'pause 'capital
         'prior 'next 'end 'home 'left 'up 'right 'down 'select 'print
         'execute 'snapshot 'insert 'help 'numpad0 'numpad1 'numpad2
         'numpad3 'numpad4 'numpad5 'numpad6 'numpad7 'numpad8 'numpad9

collects/tests/framework/README

@@ -13,9 +13,9 @@ gracket to exit in order to pass, this governor is required.
 
 To run a test use:
 
-   framework-test <test.ss> ...
+   framework-test <test.rkt> ...
 
-where <test.ss> is the name of one of the tests below.  Alternatively,
+where <test.rkt> is the name of one of the tests below.  Alternatively,
 pass no command-line arguments to run all of the tests.
 
 Some of the tests in this file are not yet present in the
@@ -26,17 +26,17 @@ OS X: you will have to click on the newly started gracket
 processes in the doc while the test suite runs or it will
 signal failures when there aren't any.
 
-- load: |# load.ss #|
+- load: |# load.rkt #|
 
   | This tests that the advertised ways of loading the framework at
   | it's components all work.
 
-- exit: |# exit.ss #|
+- exit: |# exit.rkt #|
 
   | This tests that exit:exit really exits and that the exit callbacks
   | are actually run.
 
-- preferences: |# prefs.ss #|
+- preferences: |# prefs.rkt #|
 
   | This tests that preferences are saved and restored correctly, both
   | immediately and across reboots of gracket.
@@ -48,20 +48,20 @@ signal failures when there aren't any.
   | Each test assumes that the others pass; this may yield strange
   | error messages when one fails.
 
-  - frames: |# frame.ss #|
+  - frames: |# frame.rkt #|
-  - canvases: |# canvas.ss #|
+  - canvases: |# canvas.rkt #|
-  - texts: |# text.ss #|
+  - texts: |# text.rkt #|
-  - pasteboards: |# pasteboard.ss #|
+  - pasteboards: |# pasteboard.rkt #|
 
-- keybindings: |# keys.ss #|
+- keybindings: |# keys.rkt #|
 
   | This tests the misc (non-scheme) keybindings
 
-- searching: |# search.ss #|
+- searching: |# search.rkt #|
 
   | This tests the search results
 
-- group tests: |# group-test.ss #|
+- group tests: |# group-test.rkt #|
 
   | make sure that mred:the-frame-group records frames correctly.
   | fake user input expected.
@@ -75,15 +75,15 @@ signal failures when there aren't any.
 
   | Tests the scheme: section
 
-  |# scheme.ss #|
+  |# scheme.rkt #|
 
 - |# (interactive #| tests
 
   | these tests require intervention by people. Clicking and whatnot
 
-  - panel:single |# panel.ss #|
+  - panel:single |# panel.rkt #|
 
-  - garbage collection: |# mem.ss #|
+  - garbage collection: |# mem.rkt #|
 
     | These tests will create objects in various configurations and
     | make sure that they are garbage collected

collects/tests/framework/keys.rkt

@@ -80,16 +80,32 @@
   (test-canonicalize 11 "esc;s:a" "esc;s:a")
   (test-canonicalize 12 "s:a;esc" "s:a;esc")
   
+  
+  ;; a key-spec is (make-key-spec buff-spec buff-spec (listof ?) (listof ?) (listof ?))
+  ;; a key-spec represents a test case for a key; 'before' contains the
+  ;; content of a buffer, and 'after' represents the desired content of the
+  ;; buffer after the keypress.  The keypress(es) in question are specified
+  ;; independently for the three platforms by the respective 'macos', 'unix',
+  ;; and 'windows' fields.
   (define-struct key-spec (before after macos unix windows))
+  
+  ;; an abstraction to use when all platforms have the same sequence of keys
+  (define (make-key-spec/allplatforms before after keys)
+    (make-key-spec before after keys keys keys))
+  
+  ;; a buff-spec is (make-buff-spec string nat nat)
+  ;; a buff-spec represents a buffer state; the content of the buffer,
+  ;; and the start and end of the highlighted region.
   (define-struct buff-spec (string start end))
   
+  ;; the keybindings test cases applied to frame:text% editors
   (define global-specs
     (list
      (make-key-spec (make-buff-spec "abc" 1 1)
                     (make-buff-spec "abc" 2 2)
-                    (list '(#\f control) '(right))
+                    (list '((#\f control)) '((right)))
-                    (list '(#\f control) '(right))
+                    (list '((#\f control)) '((right)))
-                    (list '(#\f control) '(right)))))
+                    (list '((#\f control)) '((right))))))
   
   (define (build-open-bracket-spec str pos char)
     (make-key-spec (make-buff-spec str pos pos)
@@ -99,22 +115,23 @@
                                    (substring str pos (string-length str)))
                     (+ pos 1)
                     (+ pos 1))
-                   (list (list #\[))
+                   (list (list (list #\[)))
-                   (list (list #\[))
+                   (list (list (list #\[)))
-                   (list (list #\[))))
+                   (list (list (list #\[)))))
   
+  ;; the keybindings test cases applied to scheme:text% editors
   (define scheme-specs
     (list 
      (make-key-spec (make-buff-spec "(abc (def))" 4 4)
                     (make-buff-spec "(abc (def))" 10 10)
-                    (list '(right alt))
+                    (list '((right alt)))
-                    (list '(right alt))
+                    (list '((right alt)))
-                    (list '(right alt)))
+                    (list '((right alt))))
      (make-key-spec (make-buff-spec "'(abc (def))" 1 1)
                     (make-buff-spec "'(abc (def))" 12 12)
-                    (list '(right alt))
+                    (list '((right alt)))
-                    (list '(right alt))
+                    (list '((right alt)))
-                    (list '(right alt)))
+                    (list '((right alt))))
      #|
      (make-key-spec (make-buff-spec "'(abc (def))" 0 0)
                     (make-buff-spec "'(abc (def))" 12 12)
@@ -159,36 +176,101 @@
      (build-open-bracket-spec "(let ([])(" 10 #\()
      (build-open-bracket-spec "(local " 7 #\[)
      (build-open-bracket-spec "(local []" 9 #\()
+     ;; test to show that multi-keystrokes works:
+     (make-key-spec/allplatforms
+      (make-buff-spec "" 0 0) 
+      (make-buff-spec "zx" 2 2)
+      (list '((#\z) (#\x))))
+     ;; remove-enclosing-parens :
+     (make-key-spec/allplatforms
+      (make-buff-spec "(abc def)" 1 1)
+      (make-buff-spec "abc" 0 0)
+      (list '((#\c control) (#\o control))))
+     ;; (is this the desired behavior?):
+     (make-key-spec/allplatforms
+      (make-buff-spec "(abc def)" 2 3)
+      (make-buff-spec "bc" 0 0)
+      (list '((#\c control) (#\o control))))
+     ;; insert-()-pair :
+     (make-key-spec/allplatforms
+      (make-buff-spec "abc" 0 0)
+      (make-buff-spec "()abc" 1 1)
+      (list '((escape) (#\())))
+     (make-key-spec/allplatforms
+      (make-buff-spec "abc" 0 2)
+      (make-buff-spec "(ab)c" 1 1)
+      (list '((escape) (#\())))
+     ;; toggle-square-round-parens :
+     ; () -> []
+     (make-key-spec/allplatforms
+      (make-buff-spec "(a)" 0 0)
+      (make-buff-spec "[a]" 0 0)
+      (list '((#\c control) (#\[ control))))
+     ; [] -> ()
+     (make-key-spec/allplatforms
+      (make-buff-spec "[a]" 0 0)
+      (make-buff-spec "(a)" 0 0)
+      (list '((#\c control) (#\[ control))))
+     ; enclosed sexps
+     (make-key-spec/allplatforms
+      (make-buff-spec "[a (def )b]" 0 0)
+      (make-buff-spec "(a (def )b)" 0 0)
+      (list '((#\c control) (#\[ control))))
+     ; extra preceding whitespace
+     (make-key-spec/allplatforms
+      (make-buff-spec "  \n [a (def )b]" 0 0)
+      (make-buff-spec "  \n (a (def )b)" 0 0)
+      (list '((#\c control) (#\[ control))))
+     ; cursor not at beginning of buffer
+     (make-key-spec/allplatforms
+      (make-buff-spec "  \n [a (def )b]" 1 1)
+      (make-buff-spec "  \n (a (def )b)" 1 1)
+      (list '((#\c control) (#\[ control))))
+     ; intervening non-paren sexp
+     (make-key-spec/allplatforms
+      (make-buff-spec "  \nf [a (def )b]" 1 1)
+      (make-buff-spec "  \nf [a (def )b]" 1 1)
+      (list '((#\c control) (#\[ control))))
+     ;; at end of buffer (hence sexp-forward returns #f):
+     (make-key-spec/allplatforms
+      (make-buff-spec "[a]" 3 3)
+      (make-buff-spec "[a]" 3 3)
+      (list '((#\c control) (#\[ control))))
      ))
   
   (send-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #t))
   (send-sexp-to-mred `(send (make-object frame:basic% "dummy to trick frame group") show #t))
   (wait-for-frame "dummy to trick frame group")
   
+  ;; test-key : key-spec -> 
+  ;;   evaluates a test case represented as a key-spec
   (define (test-key key-spec)
-    (let* ([keys ((case (system-type)
+    (let* ([key-sequences 
-                    [(macos macosx) key-spec-macos]
+            ((case (system-type)
-                    [(unix) key-spec-unix]
+               [(macos macosx) key-spec-macos]
-                    [(windows) key-spec-windows])
+               [(unix) key-spec-unix]
-                  key-spec)]
+               [(windows) key-spec-windows])
+             key-spec)]
            [before (key-spec-before key-spec)]
            [after (key-spec-after key-spec)]
-           [process-key
+           [process-key-sequence
-            (lambda (key)
+            (lambda (key-sequence)
               (let ([text-expect (buff-spec-string after)]
                     [start-expect (buff-spec-start after)]
                     [end-expect (buff-spec-end after)])
-                (test key
+                (test key-sequence
                       (lambda (x) (equal? x (vector text-expect start-expect end-expect)))
                       `(let* ([text (send (get-top-level-focus-window) get-editor)])
                          (send text erase)
                          (send text insert ,(buff-spec-string before))
                          (send text set-position ,(buff-spec-start before) ,(buff-spec-end before))
-                         (test:keystroke ',(car key) ',(cdr key))
+                         ,@(map (lambda (key) `(test:keystroke ',(car key) ',(cdr key)))
+                                key-sequence)
                          (vector (send text get-text)
                                  (send text get-start-position)
                                  (send text get-end-position))))))])
-      (for-each process-key keys)))
+      (for-each process-key-sequence key-sequences)))
+  
   
   (define (test-specs frame-name frame-class specs)
     (send-sexp-to-mred `(send (make-object ,frame-class ,frame-name) show #t))
@@ -196,7 +278,7 @@
     (for-each test-key specs)
     (send-sexp-to-mred `(send (get-top-level-focus-window) close)))
   
-  (test-specs "global keybingings test" 'frame:text% global-specs)
+  (test-specs "global keybindings test" 'frame:text% global-specs)
   (test-specs "scheme mode keybindings test" 
               '(class frame:editor%
                  (define/override (get-editor%) scheme:text%)

collects/tests/framework/main.rkt

@@ -48,7 +48,10 @@
  "framework-test" (current-command-line-arguments) command-line-flags
  (lambda (collected . files)
    (when (null? files) (set! batch? #t))
-   (let ([files (filter (lambda (x) (member x all-files)) files)])
+   (let* ([throwouts (remove* all-files files)]
+          [files (remove* throwouts files)])
+     (when (not (null? throwouts))
+       (debug-printf admin "  ignoring files that don't occur in all-files: ~s\n" throwouts))
      (set! files-to-process
            (cond [all?   all-files]
                  [batch? (remove* interactive-files all-files)]