another attempt to get the drscheme gui test suite in shape to be run by drdr
svn: r18004
This commit is contained in:
Robby Findler
parent
43e74725bf
commit
75a60162b0
|
|
@ -11,7 +11,7 @@
|
|||
[use-get/put-dialog (-> (-> any) path? void?)]
|
||||
[set-module-language! (->* () (boolean?) void?)])
|
||||
|
||||
(provide fire-up-drscheme
|
||||
(provide fire-up-drscheme-and-run-tests
|
||||
save-drscheme-window-as
|
||||
do-execute
|
||||
test-util-error
|
||||
|
|
@ -622,13 +622,35 @@
|
|||
;; but just to print and return.
|
||||
(define orig-display-handler (error-display-handler))
|
||||
|
||||
(define (fire-up-drscheme)
|
||||
(dynamic-require 'drscheme #f)
|
||||
|
||||
;; reset the uncaught exception handler to be sure we kill everything (drscheme sets it)
|
||||
(uncaught-exception-handler
|
||||
(λ (x)
|
||||
(if (exn? x)
|
||||
(orig-display-handler (exn-message x) x)
|
||||
(fprintf (current-error-port) "uncaught exception ~s\n" x))
|
||||
(exit 1))))
|
||||
(define (fire-up-drscheme-and-run-tests run-test)
|
||||
(let ()
|
||||
;; change the preferences system so that it doesn't write to
|
||||
;; a file; partly to avoid problems of concurrency in drdr
|
||||
;; but also to make the test suite easier for everyone to run.
|
||||
(let ([prefs-table (make-hash)])
|
||||
(fw:preferences:low-level-put-preferences
|
||||
(lambda (names vals)
|
||||
(for-each (lambda (name val) (hash-set! prefs-table name val))
|
||||
names vals)))
|
||||
(fw:preferences:low-level-get-preference
|
||||
(lambda (name [fail (lambda () #f)])
|
||||
(hash-ref prefs-table name fail))))
|
||||
|
||||
(dynamic-require 'drscheme #f)
|
||||
|
||||
;; set all preferences to their defaults (some pref values may have
|
||||
;; been read by this point, but hopefully that won't affect much
|
||||
;; of the startup of drscheme)
|
||||
(fw:preferences:restore-defaults)
|
||||
|
||||
(thread (λ ()
|
||||
(let ([orig-display-handler (error-display-handler)])
|
||||
(uncaught-exception-handler
|
||||
(λ (x)
|
||||
(if (exn? x)
|
||||
(orig-display-handler (exn-message x) x)
|
||||
(fprintf (current-error-port) "uncaught exception ~s\n" x))
|
||||
(exit 1))))
|
||||
(run-test)
|
||||
(exit)))
|
||||
(yield (make-semaphore 0))))
|
||||
|
|
@ -183,20 +183,15 @@ add this test:
|
|||
(define drs-frame #f)
|
||||
(define interactions-text #f)
|
||||
|
||||
(let ([s (make-semaphore)])
|
||||
(fire-up-drscheme)
|
||||
(thread
|
||||
(λ ()
|
||||
(set! drs-frame (wait-for-drscheme-frame))
|
||||
(set! interactions-text (send drs-frame get-interactions-text))
|
||||
(set-language-level! (list #rx"Pretty Big"))
|
||||
(clear-definitions drs-frame)
|
||||
(do-execute drs-frame)
|
||||
|
||||
(output-err-port-checking) ;; must come first
|
||||
;(long-io/execute-test)
|
||||
(reading-test)
|
||||
(semaphore-post s)))
|
||||
(yield s)
|
||||
(exit))
|
||||
(fire-up-drscheme-and-run-tests
|
||||
(λ ()
|
||||
(set! drs-frame (wait-for-drscheme-frame))
|
||||
(set! interactions-text (send drs-frame get-interactions-text))
|
||||
(set-language-level! (list #rx"Pretty Big"))
|
||||
(clear-definitions drs-frame)
|
||||
(do-execute drs-frame)
|
||||
|
||||
(output-err-port-checking) ;; must come first
|
||||
;;(long-io/execute-test)
|
||||
(reading-test)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1352,7 +1352,4 @@ the settings above should match r5rs
|
|||
(go pretty-big)
|
||||
(go r5rs))
|
||||
|
||||
(let ()
|
||||
(fire-up-drscheme)
|
||||
(thread (λ () (run-test) (exit)))
|
||||
(yield (make-semaphore)))
|
||||
(fire-up-drscheme-and-run-tests run-test)
|
||||
|
|
|
|||
|
|
@ -129,7 +129,6 @@
|
|||
error-ranges-expected
|
||||
(send interactions-text get-error-ranges))))])))))
|
||||
|
||||
|
||||
(define drs 'not-yet-drs-frame)
|
||||
(define interactions-text 'not-yet-interactions-text)
|
||||
(define definitions-text 'not-yet-definitions-text)
|
||||
|
|
|
|||
|
|
@ -141,7 +141,7 @@
|
|||
(provide s)
|
||||
(define-syntax (s stx) e))}
|
||||
@t{(require m) s}
|
||||
@rx{module-lang-test-tmp2.ss:1:[67][90]: compile: bad syntax;
|
||||
@rx{compile: bad syntax;
|
||||
literal data is not allowed, because no #%datum syntax transformer
|
||||
is bound in: 1$})
|
||||
(test @t{(module tmp mzscheme
|
||||
|
|
@ -247,11 +247,7 @@
|
|||
f
|
||||
(f)
|
||||
--
|
||||
#t
|
||||
#:error-ranges
|
||||
(λ (defs ints)
|
||||
(list (make-srcloc ints 3 3 107 1)
|
||||
(make-srcloc ints 3 2 106 3))))
|
||||
#t)
|
||||
|
||||
;; test protection against user-code changing the namespace
|
||||
(test @t{#lang scheme/base
|
||||
|
|
@ -265,7 +261,4 @@
|
|||
|
||||
|
||||
(require "drscheme-test-util.ss")
|
||||
(let ()
|
||||
(fire-up-drscheme)
|
||||
(thread (λ () (run-test) (exit)))
|
||||
(yield (make-semaphore 0)))
|
||||
(fire-up-drscheme-and-run-tests run-test)
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@ This produces an ACK message
|
|||
backtrace-image-string
|
||||
" "
|
||||
file-image-string
|
||||
" ../../mred/private/snipfile.ss:"))
|
||||
" .*mred/private/snipfile.ss:"))
|
||||
"[0-9]+:[0-9]+: "
|
||||
(regexp-quote str))))
|
||||
|
||||
|
|
@ -190,8 +190,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: reference to undefined identifier: xx"
|
||||
"reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -266,8 +266,8 @@ This produces an ACK message
|
|||
"define-values: cannot change constant identifier: +"
|
||||
"define-values: cannot change constant identifier: +"
|
||||
"define-values: cannot change constant identifier: +"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+")
|
||||
'interactions
|
||||
#f
|
||||
void
|
||||
|
|
@ -305,8 +305,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:7: reference to undefined identifier: xx"
|
||||
"reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -350,8 +350,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:2:0: reference to undefined identifier: xx"
|
||||
"reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -417,8 +417,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: reference to undefined identifier: x"
|
||||
"reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -457,8 +457,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #<void>"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: expt: expected argument of type <number>; given #<void>"
|
||||
"expt: expected argument of type <number>; given #<void>"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -507,8 +507,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: reference to undefined identifier: x"
|
||||
"1\n2\nreference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -620,8 +620,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f\n15"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:5:19: expt: expected argument of type <number>; given #f\n15"
|
||||
"expt: expected argument of type <number>; given #f\n15"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -644,12 +644,12 @@ This produces an ACK message
|
|||
|
||||
;; should produce a syntax object with a turn-down triangle.
|
||||
(mktest "(write (list (syntax x)))"
|
||||
(#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:21.*>\"})")
|
||||
(#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp3.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
|
||||
#rx"({embedded \".#<syntax:.*repl-test-tmp3.ss:1:21.*>\"})")
|
||||
'interactions
|
||||
#f
|
||||
void
|
||||
|
|
@ -685,12 +685,12 @@ This produces an ACK message
|
|||
|
||||
(mktest "(parameterize ([current-output-port (open-output-string)]) (fprintf (current-error-port) \"~e\" #'foot))"
|
||||
|
||||
(#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:96.*>")
|
||||
(#rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp3.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
|
||||
#rx"#<syntax:.*repl-test-tmp3.ss:1:96.*>")
|
||||
'interactions
|
||||
#f
|
||||
void
|
||||
|
|
@ -719,8 +719,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:6:15: expt: expected argument of type <number>; given #f"
|
||||
"expt: expected argument of type <number>; given #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -796,8 +796,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:3:13: procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
"procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -898,8 +898,8 @@ This produces an ACK message
|
|||
"{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: reference to undefined identifier: xx"
|
||||
"reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
|
||||
'definitions
|
||||
#f
|
||||
void
|
||||
|
|
@ -1069,7 +1069,8 @@ This produces an ACK message
|
|||
(define backtrace-image-string "{stop-multi.png}")
|
||||
(define file-image-string "{stop-22x22.png}")
|
||||
|
||||
(define tmp-load-directory
|
||||
(define tmp-load-directory (find-system-path 'temp-dir)
|
||||
#;
|
||||
(normal-case-path
|
||||
(normalize-path
|
||||
(collection-path "tests" "drscheme"))))
|
||||
|
|
@ -1080,8 +1081,6 @@ This produces an ACK message
|
|||
(define tmp-load3-short-filename "repl-test-tmp3.ss")
|
||||
(define tmp-load3-filename (build-path tmp-load-directory tmp-load3-short-filename))
|
||||
|
||||
tmp-load-filename
|
||||
|
||||
(define (cleanup-tmp-files)
|
||||
(when (file-exists? tmp-load-filename) (delete-file tmp-load-filename))
|
||||
(when (file-exists? tmp-load3-filename) (delete-file tmp-load3-filename)))
|
||||
|
|
@ -1515,13 +1514,10 @@ tmp-load-filename
|
|||
(string-append a b)))
|
||||
|
||||
|
||||
(let ()
|
||||
(fire-up-drscheme)
|
||||
(wait-for-drscheme-frame) ;; after this point, it is safe to set the exit handler
|
||||
(exit-handler
|
||||
(let ([eh (exit-handler)])
|
||||
(λ (val)
|
||||
(cleanup-tmp-files)
|
||||
(eh val))))
|
||||
(thread (λ () (run-test) (exit)))
|
||||
(yield (make-semaphore 0)))
|
||||
(exit-handler
|
||||
(let ([eh (exit-handler)])
|
||||
(λ (val)
|
||||
(cleanup-tmp-files)
|
||||
(eh val))))
|
||||
|
||||
(fire-up-drscheme-and-run-tests run-test)
|
||||
|
|
|
|||
7
collects/tests/drscheme/run.sh
Normal file
7
collects/tests/drscheme/run.sh
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#!/bin/sh -x
|
||||
mred module-lang-test.ss &&
|
||||
mred repl-test.ss &&
|
||||
mred io.ss &&
|
||||
mred language-test.ss &&
|
||||
mred syncheck-test.ss &&
|
||||
mred teachpack.ss
|
||||
|
|
@ -849,28 +849,21 @@ trigger runtime errors in check syntax.
|
|||
(list '((27 33) (19 26) (36 49) (53 59) (64 66))))))
|
||||
|
||||
(define (main)
|
||||
(let ([s (make-semaphore 0)])
|
||||
(thread
|
||||
(λ ()
|
||||
(let ([drs (wait-for-drscheme-frame)])
|
||||
(set-language-level! (list "Pretty Big"))
|
||||
(do-execute drs)
|
||||
(let* ([defs (send drs get-definitions-text)]
|
||||
[filename (make-temporary-file "syncheck-test~a")])
|
||||
(let-values ([(dir _1 _2) (split-path filename)])
|
||||
(send defs save-file filename)
|
||||
(preferences:set 'framework:coloring-active #f)
|
||||
(for-each (run-one-test (normalize-path dir)) tests)
|
||||
(preferences:set 'framework:coloring-active #t)
|
||||
(send defs save-file) ;; clear out autosave
|
||||
(send defs set-filename #f)
|
||||
(delete-file filename)
|
||||
;; let the app die.
|
||||
(semaphore-post s))))))
|
||||
(fire-up-drscheme)
|
||||
(yield s)
|
||||
(printf "Tests complete.\n")
|
||||
(exit)))
|
||||
(fire-up-drscheme-and-run-tests
|
||||
(λ ()
|
||||
(let ([drs (wait-for-drscheme-frame)])
|
||||
(set-language-level! (list "Pretty Big"))
|
||||
(do-execute drs)
|
||||
(let* ([defs (send drs get-definitions-text)]
|
||||
[filename (make-temporary-file "syncheck-test~a")])
|
||||
(let-values ([(dir _1 _2) (split-path filename)])
|
||||
(send defs save-file filename)
|
||||
(preferences:set 'framework:coloring-active #f)
|
||||
(for-each (run-one-test (normalize-path dir)) tests)
|
||||
(preferences:set 'framework:coloring-active #t)
|
||||
(send defs save-file) ;; clear out autosave
|
||||
(send defs set-filename #f)
|
||||
(delete-file filename)))))))
|
||||
|
||||
(define ((run-one-test save-dir) test)
|
||||
(let* ([drs (wait-for-drscheme-frame)]
|
||||
|
|
|
|||
|
|
@ -238,7 +238,4 @@
|
|||
;(bad-tests)
|
||||
(test-built-in-teachpacks))
|
||||
|
||||
(let ()
|
||||
(fire-up-drscheme)
|
||||
(thread (λ () (run-test) (exit)))
|
||||
(yield (make-semaphore)))
|
||||
(fire-up-drscheme-and-run-tests run-test)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user