From 760ec887b9497e2d386dde7db29aa44270a54ec2 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 11 Feb 2012 08:16:57 -0600 Subject: [PATCH] split up the REPL test to get parallelism in drdr (and hopefully avoid timeouts) --- .../drracket/{ => private}/repl-test.rkt | 90 +++++++++---------- collects/tests/drracket/repl-test-debug.rkt | 4 + .../tests/drracket/repl-test-debugprofile.rkt | 4 + collects/tests/drracket/repl-test-misc.rkt | 4 + collects/tests/drracket/repl-test-raw.rkt | 4 + 5 files changed, 59 insertions(+), 47 deletions(-) rename collects/tests/drracket/{ => private}/repl-test.rkt (96%) create mode 100644 collects/tests/drracket/repl-test-debug.rkt create mode 100644 collects/tests/drracket/repl-test-debugprofile.rkt create mode 100644 collects/tests/drracket/repl-test-misc.rkt create mode 100644 collects/tests/drracket/repl-test-raw.rkt diff --git a/collects/tests/drracket/repl-test.rkt b/collects/tests/drracket/private/repl-test.rkt similarity index 96% rename from collects/tests/drracket/repl-test.rkt rename to collects/tests/drracket/private/repl-test.rkt index 4d7784c372..5fc37941de 100644 --- a/collects/tests/drracket/repl-test.rkt +++ b/collects/tests/drracket/private/repl-test.rkt @@ -13,10 +13,12 @@ This produces an ACK message |# -(require "private/drracket-test-util.rkt" +(require "drracket-test-util.rkt" mred framework) +(provide/contract [run-test (-> (listof (or/c 'raw 'debug 'debug/profile 'misc)) any)]) + (define-struct loc (line col offset)) ;; loc = (make-loc number number number) ;; all numbers in loc structs start at zero. @@ -832,12 +834,12 @@ This produces an ACK message void) (mktest "(new snip%)" - ("{unknown snip: #(struct:object:snip% ...)}\n" - "{unknown snip: #(struct:object:snip% ...)}\n" - "{unknown snip: #(struct:object:snip% ...)}\n" - "{unknown snip: #(struct:object:snip% ...)}\n" - "{unknown snip: #(struct:object:snip% ...)}\n" - "{unknown snip: #(struct:object:snip% ...)}\n") + ("{unknown snip: (object:snip% ...)}\n" + "{unknown snip: (object:snip% ...)}\n" + "{unknown snip: (object:snip% ...)}\n" + "{unknown snip: (object:snip% ...)}\n" + "{unknown snip: (object:snip% ...)}\n" + "{unknown snip: (object:snip% ...)}\n") 'interactions #f void @@ -1092,7 +1094,7 @@ This produces an ACK message (when (file-exists? tmp-load-filename) (delete-file tmp-load-filename)) (when (file-exists? tmp-load3-filename) (delete-file tmp-load3-filename))) -(define (run-test) +(define (run-test which-tests) (define drscheme-frame (wait-for-drscheme-frame)) @@ -1297,8 +1299,7 @@ This produces an ACK message (fprintf (current-error-port) "FAILED load test ~a for ~s\n expected: ~s\n got: ~s\n" short-filename - program load-answer received-load) - (semaphore-wait (make-semaphore 0))))))]) + program load-answer received-load)))))]) (load-test tmp-load-short-filename (make-load-answer in-vector language-cust #f)) (when (file-exists? tmp-load3-filename) (delete-file tmp-load3-filename)) @@ -1322,35 +1323,14 @@ This produces an ACK message (printf "tests finished: all ~a tests passed\n" tests) (fprintf (current-error-port) "tests finished: ~a failed out of ~a total\n" failures tests))) - (define (run-test-in-language-level language-cust) - (let ([level (list #rx"Pretty Big")]) - (printf "running tests: ~a\n" language-cust) - (case language-cust - [(raw) - (begin - (set-language-level! level #f) - (test:set-radio-box-item! "No debugging or profiling") - (let ([f (test:get-active-top-level-window)]) - (test:button-push "OK") - (wait-for-new-frame f)))] - [(debug) - (set-language-level! level)] - [(debug/profile) - (begin - (set-language-level! level #f) - (test:set-radio-box-item! "Debugging and profiling") - (let ([f (test:get-active-top-level-window)]) - (test:button-push "OK") - (wait-for-new-frame f)))]) - - - (random-seed-test) - - (test:new-window definitions-canvas) - (clear-definitions drscheme-frame) - (do-execute drscheme-frame) - (let/ec escape - (for-each (run-single-test (get-int-pos) escape language-cust) test-data)))) + (define (run-main-tests language-cust) + (random-seed-test) + + (test:new-window definitions-canvas) + (clear-definitions drscheme-frame) + (do-execute drscheme-frame) + (let/ec escape + (for-each (run-single-test (get-int-pos) escape language-cust) test-data))) (define kill-menu-item "Force the Program to Quit") @@ -1484,13 +1464,31 @@ This produces an ACK message ;; they are both run here because debug uses the automatic-compilation ;; stuff and debug/profile does not (so they use different instantiations ;; of the stacktrace module. - (run-test-in-language-level 'raw) - (run-test-in-language-level 'debug) - (run-test-in-language-level 'debug/profile) - (kill-tests) - (callcc-test) - (top-interaction-test) + (define level (list #rx"Pretty Big")) + (when (memq 'raw which-tests) + (set-language-level! level #f) + (test:set-radio-box-item! "No debugging or profiling") + (let ([f (test:get-active-top-level-window)]) + (test:button-push "OK") + (wait-for-new-frame f)) + (run-main-tests 'raw)) + (when (memq 'debug which-tests) + (set-language-level! level) + (run-main-tests 'debug)) + (when (memq 'debug/profile which-tests) + (set-language-level! level #f) + (test:set-radio-box-item! "Debugging and profiling") + (let ([f (test:get-active-top-level-window)]) + (test:button-push "OK") + (wait-for-new-frame f)) + (run-main-tests 'debug/profile)) + (when (memq 'misc which-tests) + (set-language-level! level #t) + (kill-tests) + (callcc-test) + (top-interaction-test)) + (final-report)) (define (insert-in-definitions/newlines drs str) @@ -1531,5 +1529,3 @@ This produces an ACK message (λ (val) (cleanup-tmp-files) (eh val)))) - -(fire-up-drscheme-and-run-tests run-test) diff --git a/collects/tests/drracket/repl-test-debug.rkt b/collects/tests/drracket/repl-test-debug.rkt new file mode 100644 index 0000000000..e8308e29ca --- /dev/null +++ b/collects/tests/drracket/repl-test-debug.rkt @@ -0,0 +1,4 @@ +#lang racket/base +(require "private/repl-test.rkt" "private/drracket-test-util.rkt") +(fire-up-drscheme-and-run-tests (λ () (run-test '(debug)))) + diff --git a/collects/tests/drracket/repl-test-debugprofile.rkt b/collects/tests/drracket/repl-test-debugprofile.rkt new file mode 100644 index 0000000000..1d3fa38815 --- /dev/null +++ b/collects/tests/drracket/repl-test-debugprofile.rkt @@ -0,0 +1,4 @@ +#lang racket/base +(require "private/repl-test.rkt" "private/drracket-test-util.rkt") +(fire-up-drscheme-and-run-tests (λ () (run-test '(debug/profile)))) + diff --git a/collects/tests/drracket/repl-test-misc.rkt b/collects/tests/drracket/repl-test-misc.rkt new file mode 100644 index 0000000000..6875573ac3 --- /dev/null +++ b/collects/tests/drracket/repl-test-misc.rkt @@ -0,0 +1,4 @@ +#lang racket/base +(require "private/repl-test.rkt" "private/drracket-test-util.rkt") +(fire-up-drscheme-and-run-tests (λ () (run-test '(misc)))) + diff --git a/collects/tests/drracket/repl-test-raw.rkt b/collects/tests/drracket/repl-test-raw.rkt new file mode 100644 index 0000000000..86ee52fdf0 --- /dev/null +++ b/collects/tests/drracket/repl-test-raw.rkt @@ -0,0 +1,4 @@ +#lang racket/base +(require "private/repl-test.rkt" "private/drracket-test-util.rkt") +(fire-up-drscheme-and-run-tests (λ () (run-test '(raw)))) +