..
original commit: a93d981ed11674b7464245c7ed7ca7f3bf503fe1
This commit is contained in:
parent
f23826dd04
commit
0346079486
|
@ -669,7 +669,8 @@
|
|||
|
||||
(define key-tag 'test:keystroke)
|
||||
(define legal-keystroke-modifiers
|
||||
(list 'alt 'control 'meta 'shift 'noalt 'nocontrol 'nometa 'noshift))
|
||||
(list 'alt 'control 'meta 'shift
|
||||
'noalt 'nocontrol 'nometa 'noshift))
|
||||
|
||||
(define valid-key-symbols
|
||||
(list 'start 'cancel 'clear 'shift 'control 'menu 'pause 'capital
|
||||
|
|
|
@ -58,7 +58,7 @@ test as last time, or `all' to run all of the tests.
|
|||
- edits to canvases: |# edit-canvas.ss #|
|
||||
- canvases to frames: |# canvas-frame.ss #|
|
||||
- edits to frames: |# edit-frame.ss #|
|
||||
- handler |# handler-test.ss #|
|
||||
- handler: handler-test.ss
|
||||
|
||||
- keybindings: |# keys.ss #|
|
||||
|
||||
|
|
|
@ -136,10 +136,10 @@
|
|||
(send-sexp-to-mred
|
||||
`(begin (send (find-labelled-window "Full pathname") focus)
|
||||
,(case (system-type)
|
||||
[(macos) `(test:keystroke #\a '(meta))]
|
||||
[(macos macosx) `(test:keystroke #\a '(meta))]
|
||||
[(unix) `(test:keystroke #\a '(meta))]
|
||||
[(windows) `(test:keystroke #\a '(control))]
|
||||
[else (error "unknown system type: ~a" (system-type))])
|
||||
[else (error 'file-open-dialog "unknown system type: ~a" (system-type))])
|
||||
(for-each test:keystroke
|
||||
(string->list ,tmp-file))
|
||||
(test:keystroke #\return)))
|
||||
|
|
|
@ -23,7 +23,6 @@
|
|||
(void))))))
|
||||
|
||||
|
||||
(test/load "specs.ss" '(contract (lambda (x) #t) 1 'pos 'neg))
|
||||
(test/load "gui-utils.ss" 'gui-utils:next-untitled-name)
|
||||
(test/load "test.ss" 'test:run-interval)
|
||||
(test/load "macro.ss" '(mixin () () ()))
|
||||
|
@ -34,8 +33,7 @@
|
|||
(test/load "framework.ss" '(list test:button-push
|
||||
gui-utils:next-untitled-name
|
||||
frame:basic-mixin
|
||||
(mixin () () ())
|
||||
(contract (lambda (x) #t) 1 'pos 'neg)))
|
||||
(mixin () () ())))
|
||||
|
||||
;; ensures that all of the names in the signature are provided
|
||||
;; by (require (lib "framework.ss" "framework"))
|
||||
|
|
|
@ -35,28 +35,11 @@
|
|||
(or (get-only-these-tests) null))))
|
||||
("Only run test named <test-name>" "test-name")])))
|
||||
|
||||
(define saved-command-line-file (build-path (collection-path "tests" "framework")
|
||||
"saved-command-line.ss"))
|
||||
(define parsed-argv
|
||||
(if (equal? argv (vector))
|
||||
(if (file-exists? saved-command-line-file)
|
||||
(begin
|
||||
(let ([result (call-with-input-file saved-command-line-file read)])
|
||||
(debug-printf admin "reusing command-line arguments: ~s~n" result)
|
||||
result))
|
||||
(vector))
|
||||
argv))
|
||||
|
||||
(parse-command-line "framework-test" parsed-argv command-line-flags
|
||||
(parse-command-line "framework-test" argv command-line-flags
|
||||
(lambda (collected . files)
|
||||
(set! files-to-process (if (or all? (null? files)) all-files files)))
|
||||
`("Names of the tests; defaults to all tests"))
|
||||
|
||||
(call-with-output-file saved-command-line-file
|
||||
(lambda (port)
|
||||
(write parsed-argv port))
|
||||
'truncate)
|
||||
|
||||
(when (file-exists? preferences-file)
|
||||
(debug-printf admin " saving preferences file ~s to ~s~n" preferences-file old-preferences-file)
|
||||
(if (file-exists? old-preferences-file)
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
|
||||
(module test-suite-utils mzscheme
|
||||
(require (lib "launcher.ss" "launcher")
|
||||
(lib "pretty.ss")
|
||||
|
@ -82,10 +83,17 @@
|
|||
|
||||
(define (restart-mred)
|
||||
(shutdown-mred)
|
||||
((case (system-type)
|
||||
[(macos) system*]
|
||||
[else (lambda (x) (thread (lambda () (system* x))))])
|
||||
(mred-program-launcher-path "Framework Test Engine"))
|
||||
(case (system-type)
|
||||
[(macos) (system* (mred-program-launcher-path "Framework Test Engine"))]
|
||||
[(macosx)
|
||||
(thread
|
||||
(lambda ()
|
||||
(system*
|
||||
(build-path (collection-path "mzlib") 'up 'up "bin" "mred")
|
||||
"-mvqt"
|
||||
(build-path (collection-path "tests" "framework")
|
||||
"framework-test-engine.ss"))))]
|
||||
[else (thread (lambda () (system* (mred-program-launcher-path "Framework Test Engine"))))])
|
||||
(debug-printf mz-tcp "accepting listener~n")
|
||||
(let-values ([(in out) (tcp-accept listener)])
|
||||
(set! in-port in)
|
||||
|
|
Loading…
Reference in New Issue
Block a user