suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

another attempt to get the drscheme gui test suite in shape to be run by drdr

Browse Source 
svn: r18004
This commit is contained in:
Robby Findler 2010-02-06 17:13:49 +00:00
parent 43e74725bf
commit 75a60162b0
9 changed files with 115 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
collects/tests/drscheme/drscheme-test-util.ss
View File

@ -11,7 +11,7 @@
[use-get/put-dialog (-> (-> any) path? void?)] [use-get/put-dialog (-> (-> any) path? void?)]
[set-module-language! (->* () (boolean?) void?)]) [set-module-language! (->* () (boolean?) void?)])
(provide fire-up-drscheme (provide fire-up-drscheme-and-run-tests
save-drscheme-window-as save-drscheme-window-as
do-execute do-execute
test-util-error test-util-error
@ -622,13 +622,35 @@
;; but just to print and return. ;; but just to print and return.
(define orig-display-handler (error-display-handler)) (define orig-display-handler (error-display-handler))
(define (fire-up-drscheme) (define (fire-up-drscheme-and-run-tests run-test)
(dynamic-require 'drscheme #f) (let ()
;; change the preferences system so that it doesn't write to
;; reset the uncaught exception handler to be sure we kill everything (drscheme sets it) ;; a file; partly to avoid problems of concurrency in drdr
(uncaught-exception-handler ;; but also to make the test suite easier for everyone to run.
(λ (x) (let ([prefs-table (make-hash)])
(if (exn? x) (fw:preferences:low-level-put-preferences
(orig-display-handler (exn-message x) x) (lambda (names vals)
(fprintf (current-error-port) "uncaught exception ~s\n" x)) (for-each (lambda (name val) (hash-set! prefs-table name val))
(exit 1)))) 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))))

27
collects/tests/drscheme/io.ss
View File

@ -183,20 +183,15 @@ add this test:
(define drs-frame #f) (define drs-frame #f)
(define interactions-text #f) (define interactions-text #f)
(let ([s (make-semaphore)]) (fire-up-drscheme-and-run-tests
(fire-up-drscheme) (λ ()
(thread (set! drs-frame (wait-for-drscheme-frame))
(λ () (set! interactions-text (send drs-frame get-interactions-text))
(set! drs-frame (wait-for-drscheme-frame)) (set-language-level! (list #rx"Pretty Big"))
(set! interactions-text (send drs-frame get-interactions-text)) (clear-definitions drs-frame)
(set-language-level! (list #rx"Pretty Big")) (do-execute drs-frame)
(clear-definitions drs-frame)
(do-execute drs-frame) (output-err-port-checking) ;; must come first
;;(long-io/execute-test)
(output-err-port-checking) ;; must come first (reading-test)))
;(long-io/execute-test)
(reading-test)
(semaphore-post s)))
(yield s)
(exit))

5
collects/tests/drscheme/language-test.ss
View File

@ -1352,7 +1352,4 @@ the settings above should match r5rs
(go pretty-big) (go pretty-big)
(go r5rs)) (go r5rs))
(let () (fire-up-drscheme-and-run-tests run-test)
(fire-up-drscheme)
(thread (λ () (run-test) (exit)))
(yield (make-semaphore)))

1
collects/tests/drscheme/module-lang-test-utils.ss
View File

@ -129,7 +129,6 @@
error-ranges-expected error-ranges-expected
(send interactions-text get-error-ranges))))]))))) (send interactions-text get-error-ranges))))])))))
(define drs 'not-yet-drs-frame) (define drs 'not-yet-drs-frame)
(define interactions-text 'not-yet-interactions-text) (define interactions-text 'not-yet-interactions-text)
(define definitions-text 'not-yet-definitions-text) (define definitions-text 'not-yet-definitions-text)

13
collects/tests/drscheme/module-lang-test.ss
View File

@ -141,7 +141,7 @@
(provide s) (provide s)
(define-syntax (s stx) e))} (define-syntax (s stx) e))}
@t{(require m) s} @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 literal data is not allowed, because no #%datum syntax transformer
is bound in: 1$}) is bound in: 1$})
(test @t{(module tmp mzscheme (test @t{(module tmp mzscheme
@ -247,11 +247,7 @@
f f
(f) (f)
-- --
#t #t)
#:error-ranges
(λ (defs ints)
(list (make-srcloc ints 3 3 107 1)
(make-srcloc ints 3 2 106 3))))
;; test protection against user-code changing the namespace ;; test protection against user-code changing the namespace
(test @t{#lang scheme/base (test @t{#lang scheme/base
@ -265,7 +261,4 @@
(require "drscheme-test-util.ss") (require "drscheme-test-util.ss")
(let () (fire-up-drscheme-and-run-tests run-test)
(fire-up-drscheme)
(thread (λ () (run-test) (exit)))
(yield (make-semaphore 0)))

92
collects/tests/drscheme/repl-test.ss
View File

@ -73,7 +73,7 @@ This produces an ACK message
backtrace-image-string backtrace-image-string
" " " "
file-image-string file-image-string
" ../../mred/private/snipfile.ss:")) " .*mred/private/snipfile.ss:"))
"[0-9]+:[0-9]+: " "[0-9]+:[0-9]+: "
(regexp-quote str)))) (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} reference to undefined identifier: xx"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: 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" "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 'definitions
#f #f
void 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: +" "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 'interactions
#f #f
void 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} reference to undefined identifier: xx"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:7: 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" "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 'definitions
#f #f
void 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} reference to undefined identifier: xx"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:2:0: 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" "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 'definitions
#f #f
void 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} reference to undefined identifier: x"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: 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" "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 'definitions
#f #f
void 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} 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>" "{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>" "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 'definitions
#f #f
void 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} reference to undefined identifier: x"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: 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" "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 'definitions
#f #f
void 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} 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" "{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" "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 'definitions
#f #f
void void
@ -644,12 +644,12 @@ This produces an ACK message
;; should produce a syntax object with a turn-down triangle. ;; should produce a syntax object with a turn-down triangle.
(mktest "(write (list (syntax x)))" (mktest "(write (list (syntax x)))"
(#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})" (#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})" #rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:21.*>\"})" #rx"({embedded \".#<syntax:.*repl-test-tmp3.ss:1:21.*>\"})"
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})" #rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})" #rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:21.*>\"})") #rx"({embedded \".#<syntax:.*repl-test-tmp3.ss:1:21.*>\"})")
'interactions 'interactions
#f #f
void void
@ -685,12 +685,12 @@ This produces an ACK message
(mktest "(parameterize ([current-output-port (open-output-string)]) (fprintf (current-error-port) \"~e\" #'foot))" (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:.*repl-test-tmp.ss:1:96.*>"
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>" #rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:96.*>" #rx"#<syntax:.*repl-test-tmp3.ss:1:96.*>"
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>" #rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>" #rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:96.*>") #rx"#<syntax:.*repl-test-tmp3.ss:1:96.*>")
'interactions 'interactions
#f #f
void 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} 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" "{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" "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 'definitions
#f #f
void 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} 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" "{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" "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 'definitions
#f #f
void 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} reference to undefined identifier: xx"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: 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" "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 'definitions
#f #f
void void
@ -1069,7 +1069,8 @@ This produces an ACK message
(define backtrace-image-string "{stop-multi.png}") (define backtrace-image-string "{stop-multi.png}")
(define file-image-string "{stop-22x22.png}") (define file-image-string "{stop-22x22.png}")
(define tmp-load-directory (define tmp-load-directory (find-system-path 'temp-dir)
#;
(normal-case-path (normal-case-path
(normalize-path (normalize-path
(collection-path "tests" "drscheme")))) (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-short-filename "repl-test-tmp3.ss")
(define tmp-load3-filename (build-path tmp-load-directory tmp-load3-short-filename)) (define tmp-load3-filename (build-path tmp-load-directory tmp-load3-short-filename))
tmp-load-filename
(define (cleanup-tmp-files) (define (cleanup-tmp-files)
(when (file-exists? tmp-load-filename) (delete-file tmp-load-filename)) (when (file-exists? tmp-load-filename) (delete-file tmp-load-filename))
(when (file-exists? tmp-load3-filename) (delete-file tmp-load3-filename))) (when (file-exists? tmp-load3-filename) (delete-file tmp-load3-filename)))
@ -1515,13 +1514,10 @@ tmp-load-filename
(string-append a b))) (string-append a b)))
(let () (exit-handler
(fire-up-drscheme) (let ([eh (exit-handler)])
(wait-for-drscheme-frame) ;; after this point, it is safe to set the exit handler (λ (val)
(exit-handler (cleanup-tmp-files)
(let ([eh (exit-handler)]) (eh val))))
(λ (val)
(cleanup-tmp-files) (fire-up-drscheme-and-run-tests run-test)
(eh val))))
(thread (λ () (run-test) (exit)))
(yield (make-semaphore 0)))

7
collects/tests/drscheme/run.sh Normal file
View 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

37
collects/tests/drscheme/syncheck-test.ss
View File

@ -849,28 +849,21 @@ trigger runtime errors in check syntax.
(list '((27 33) (19 26) (36 49) (53 59) (64 66)))))) (list '((27 33) (19 26) (36 49) (53 59) (64 66))))))
(define (main) (define (main)
(let ([s (make-semaphore 0)]) (fire-up-drscheme-and-run-tests
(thread (λ ()
(λ () (let ([drs (wait-for-drscheme-frame)])
(let ([drs (wait-for-drscheme-frame)]) (set-language-level! (list "Pretty Big"))
(set-language-level! (list "Pretty Big")) (do-execute drs)
(do-execute drs) (let* ([defs (send drs get-definitions-text)]
(let* ([defs (send drs get-definitions-text)] [filename (make-temporary-file "syncheck-test~a")])
[filename (make-temporary-file "syncheck-test~a")]) (let-values ([(dir _1 _2) (split-path filename)])
(let-values ([(dir _1 _2) (split-path filename)]) (send defs save-file filename)
(send defs save-file filename) (preferences:set 'framework:coloring-active #f)
(preferences:set 'framework:coloring-active #f) (for-each (run-one-test (normalize-path dir)) tests)
(for-each (run-one-test (normalize-path dir)) tests) (preferences:set 'framework:coloring-active #t)
(preferences:set 'framework:coloring-active #t) (send defs save-file) ;; clear out autosave
(send defs save-file) ;; clear out autosave (send defs set-filename #f)
(send defs set-filename #f) (delete-file filename)))))))
(delete-file filename)
;; let the app die.
(semaphore-post s))))))
(fire-up-drscheme)
(yield s)
(printf "Tests complete.\n")
(exit)))
(define ((run-one-test save-dir) test) (define ((run-one-test save-dir) test)
(let* ([drs (wait-for-drscheme-frame)] (let* ([drs (wait-for-drscheme-frame)]

5
collects/tests/drscheme/teachpack.ss
View File

@ -238,7 +238,4 @@
;(bad-tests) ;(bad-tests)
(test-built-in-teachpacks)) (test-built-in-teachpacks))
(let () (fire-up-drscheme-and-run-tests run-test)
(fire-up-drscheme)
(thread (λ () (run-test) (exit)))
(yield (make-semaphore)))