move "props" test configs to test submodules or "info.rkt" files

The "props" file still has

 * ".rkt" `drdr:timeout` entries, needed until DrDr uses submodules and
   "info.rkt" files; although timeout information has been put in
   submodules for `raco test`, DrDr uses `raco test` in a way that does not
   enable timeouts, so that DrDr can implement timeouts itself (and record
   when a test times out)

 * ".rkt" `drdr:random #t` entries; not sure what to do with these, yet

 * ".rkt" `responsible` entries; not sure what to do with these, yet

 * ".rktl" `drdr:command-line #f` entries, needed until all ".rktl" files
   are disabled in DrDr

The following files were previously disabled for DrDr testing, but were
intentionally left as enabled with these changes:

pkgs/racket-pkgs/racket-test/tests/pkg/shelly.rkt
pkgs/racket-pkgs/racket-test/tests/pkg/util.rkt
pkgs/racket-pkgs/racket-test/tests/pkg/info.rkt
pkgs/racket-pkgs/racket-test/tests/pkg/basic-index.rkt
pkgs/racket-pkgs/racket-test/tests/racket/link.rkt
pkgs/racket-pkgs/racket-test/tests/racket/embed-in-c.rkt
pkgs/racket-pkgs/racket-doc/ffi/examples/use-c-printf.rkt
pkgs/racket-pkgs/racket-doc/ffi/examples/c-printf.rkt
pkgs/parser-tools-pkgs/parser-tools-lib/parser-tools/private-lex/error-tests.rkt
pkgs/mysterx/mysterx.rkt
pkgs/mysterx/main.rkt
pkgs/games/gobblet/test-model.rkt
pkgs/games/gobblet/test-explore.rkt
pkgs/games/gobblet/robot.rkt
pkgs/games/gobblet/check.rkt
pkgs/db-pkgs/db-lib/db/private/odbc/main.rkt
pkgs/db-pkgs/db-lib/db/private/odbc/ffi.rkt
pkgs/db-pkgs/db-lib/db/private/odbc/dbsystem.rkt
pkgs/db-pkgs/db-lib/db/private/odbc/connection.rkt
pkgs/distributed-places-pkgs/distributed-places-lib/racket/place/distributed/examples/hello-world.rkt
pkgs/redex-pkgs/redex-lib/redex/private/compiler/match.rkt
pkgs/redex-pkgs/redex-lib/redex/private/compiler/match.rkt
pkgs/htdp-pkgs/htdp-test/2htdp/utest/balls.rkt
pkgs/gui-pkgs/gui-test/framework/tests/test-suite-utils.rkt
pkgs/games/paint-by-numbers/raw-problems/size-calculation.rkt
pkgs/db-pkgs/db-lib/db/odbc.rkt
pkgs/compatibility-pkgs/compatibility-lib/mzlib/traceld.rkt
pkgs/cext-lib/dynext/private/stdio.rkt
pkgs/db-pkgs/db-lib/db/odbc.rkt
racket/collects/ffi/unsafe/objc.rkt
racket/collects/ffi/objc.rkt
pkgs/racket-pkgs/racket-test/tests/pkg/tests-db.rkt
pkgs/racket-pkgs/racket-test/tests/pkg/test-docs.rkt
pkgs/racket-pkgs/racket-test/tests/pkg/test-catalogs-api.rkt
pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/main.rkt
pkgs/redex-pkgs/redex-lib/redex/private/compiler/redextomatrix.rkt
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-special-env.rkt
pkgs/planet-pkgs/planet-test/tests/planet/version.rkt
pkgs/planet-pkgs/planet-test/tests/planet/test-docs-complete.rkt
pkgs/planet-pkgs/planet-test/tests/planet/lang.rkt
pkgs/planet-pkgs/planet-test/tests/planet/docs-build.rkt
pkgs/drracket-pkgs/drracket-test/tests/drracket/follow-log.rkt
pkgs/drracket-pkgs/drracket/drracket/private/dock-icon.rkt
pkgs/drracket-pkgs/drracket-test/tests/drracket/tool-lib-and-sig.rkt

pkgs/cext-lib/compiler/commands/ctool.rkt

@@ -1,5 +1,7 @@
 #lang scheme/base
 
+(module test racket/base)
+
 ;; On error, exit with 1 status code
 (error-escape-handler (lambda () (exit 1)))
 

pkgs/compiler-pkgs/compiler-lib/compiler/commands/exe-dir.rkt

@@ -29,3 +29,5 @@
  #:copy-collects (exe-dir-add-collects-dirs))
 (when (verbose)
   (printf " [output to \"~a\"]\n" dest-dir))
+
+(module test racket/base)

pkgs/compiler-pkgs/compiler-lib/compiler/commands/exe.rkt

@@ -140,3 +140,5 @@
                  (exe-aux)))])
   (when (verbose)
     (printf " [output to \"~a\"]\n" dest)))
+
+(module test racket/base)

pkgs/compiler-pkgs/compiler-lib/compiler/commands/make.rkt

@@ -7,6 +7,8 @@
          setup/parallel-build
          racket/match)
 
+(module test racket/base)
+
 (define verbose (make-parameter #f))
 (define very-verbose (make-parameter #f))
 (define disable-inlining (make-parameter #f))

pkgs/compiler-pkgs/compiler-lib/compiler/commands/pack.rkt

@@ -96,3 +96,4 @@
       (when (verbose)
         (printf " [output to \"~a\"]\n" plt-output))))
 
+(module test racket/base)

pkgs/compiler-pkgs/compiler-lib/compiler/demodularizer/batch.rkt

@@ -57,3 +57,5 @@ Here's the idea:
                  (garbage-collect-toplevels-enabled #t)]                         
                 #:args (filename) 
                 (demodularize filename (output-file))))
+
+(module test racket/base)

pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me9.rkt

@@ -3,4 +3,7 @@
   (with-output-to-file "stdout"
     (lambda () 
       (printf "~a\n" (ex)))
-    'append))
+    'append)
+  
+  (module test racket/base))
+

pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/info.rkt

@@ -12,3 +12,7 @@
                              "embed-isl.rkt"
                              "embed-isll.rkt"
                              "embed-asl.rkt"))
+
+(define test-omit-paths '("embed-me9.rkt"
+                          "embed-planet-1"
+                          "embed-planet-2"))

pkgs/compiler-pkgs/compiler-test/tests/compiler/zo-test-worker.rkt

@@ -268,3 +268,5 @@
 (command-line #:program "zo-test-worker" 
               #:args (file)
               (run-test file))
+
+(module test racket/base)

pkgs/compiler-pkgs/compiler-test/tests/compiler/zo-test.rkt

@@ -227,3 +227,9 @@ exec racket -t "$0" -- -s -t 60 -v -R $*
              (printf "~a:\n~a\n\n" (car p) (cdr p)))))))))
 
 (thread-wait final-thread)
+
+;; Test mode:
+(module test racket/base
+  (require syntax/location)
+  (parameterize ([current-command-line-arguments (vector "-I" "-S" "-t" "60" "-v" "-R")])
+    (dynamic-require (quote-module-path "..") #f)))

pkgs/db-pkgs/db-test/tests/db/programs/web-test.rkt

@@ -7,6 +7,8 @@
          racket/port
          db)
 
+(module test racket/base)
+
 #|
 This program tests the combination of virtual connections and
 connection pools in the context of web servlets, where servlet threads

pkgs/deinprogramm/deinprogramm/run-dmda-code.rkt

@@ -51,4 +51,4 @@
   (run-dmda-file
    (vector-ref (current-command-line-arguments) 0))
 
-  )
+  (module test racket/base))

pkgs/distro-build/add-catalog.rkt

@@ -4,6 +4,8 @@
          pkg/lib
          net/url)
 
+(module test racket/base)
+
 (define (add-catalog! url)
   (define s (url->string url))
   (define l (pkg-config-catalogs))

pkgs/distro-build/assemble-site.rkt

@@ -5,6 +5,8 @@
          "download-page.rkt"
          (only-in "config.rkt" extract-options))
 
+(module test racket/base)
+
 (define build-dir (build-path "build"))
 
 (define built-dir (build-path build-dir "built"))

pkgs/distro-build/drive-clients.rkt

@@ -18,6 +18,8 @@
 
 ;; See "config.rkt" for an overview.
 
+(module test racket/base)
+
 ;; ----------------------------------------
 
 (define default-release? #f)

pkgs/distro-build/install-for-docs.rkt

@@ -7,6 +7,8 @@
          (only-in "config.rkt" extract-options)
          "display-time.rkt")
 
+(module test racket/base)
+
 (define-values (dir config-file config-mode default-pkgs catalogs)
   (command-line
    #:args

pkgs/distro-build/install-pkgs.rkt

@@ -3,6 +3,8 @@
          racket/string
          (only-in "config.rkt" extract-options))
 
+(module test racket/base)
+
 (define-values (config-file config-mode default-pkgs flags)
   (command-line
    #:args

pkgs/distro-build/installer.rkt

@@ -11,6 +11,8 @@
          racket/port
          "display-time.rkt")
 
+(module test racket/base)
+
 (define release? #f)
 (define source? #f)
 (define mac-pkg? #f)

pkgs/distro-build/manage-snapshots.rkt

@@ -5,6 +5,8 @@
          "download-page.rkt"
          (only-in "config.rkt" extract-options))
 
+(module test racket/base)
+
 (define build-dir (build-path "build"))
 (define installers-dir (build-path "installers"))
 

pkgs/distro-build/pack-and-catalog.rkt

@@ -11,6 +11,8 @@
          pkg/lib
          setup/getinfo)
 
+(module test racket/base)
+
 (define pack-dest-dir #f)
 (define catalog-dirs null)
 (define native? #f)

pkgs/distro-build/pack-built.rkt

@@ -8,6 +8,8 @@
          openssl/sha1
          racket/cmdline)
 
+(module test racket/base)
+
 (define create-mode 'built)
 
 (command-line

pkgs/distro-build/pack-collects.rkt

@@ -3,6 +3,8 @@
          file/gzip
          racket/file)
 
+(module test racket/base)
+
 (define origin-dir (build-path "build" "origin"))
 
 (make-directory* origin-dir)

pkgs/distro-build/serve-catalog.rkt

@@ -15,6 +15,8 @@
          (only-in "config.rkt" extract-options)
          "readme.rkt")
 
+(module test racket/base)
+
 (define from-dir "built")
 
 (define-values (config-file config-mode 

pkgs/distro-build/set-config.rkt

@@ -5,6 +5,8 @@
          (only-in "config.rkt" extract-options)
          "url-options.rkt")
 
+(module test racket/base)
+
 (define-values (dest-config-file config-file config-mode 
                                  install-name build-stamp 
                                  default-doc-search default-catalogs)

pkgs/distro-build/unpack-collects.rkt

@@ -6,6 +6,8 @@
          file/untgz
          "display-time.rkt")
 
+(module test racket/base)
+
 (define dest-dir "bundle/racket")
 
 (define server

pkgs/drracket-pkgs/drracket-test/tests/drracket/io.rkt

@@ -209,3 +209,6 @@ add this test:
    ;;(long-io/execute-test)
    (reading-test)))
 
+(module+ test
+  (module config info
+    (define timeout 500)))

pkgs/drracket-pkgs/drracket-test/tests/drracket/language-test.rkt

@@ -1517,3 +1517,7 @@ the settings above should match r5rs
   )
 
 (fire-up-drracket-and-run-tests run-test)
+
+(module+ test
+  (module config info
+    (define timeout 1500)))

pkgs/drracket-pkgs/drracket-test/tests/drracket/module-lang-test.rkt

@@ -420,3 +420,12 @@
       "0")
 
 (fire-up-drracket-and-run-tests run-test)
+
+;; Test mode:
+(module test racket/base
+  (require syntax/location)
+  (putenv "PLTDRTEST" "yes")
+  (eval-jit-enabled #f)
+  (dynamic-require (quote-module-path "..") #f)
+  (module config info
+    (define timeout 800)))

pkgs/drracket-pkgs/drracket-test/tests/drracket/populate-compiled.rkt

@@ -4,6 +4,8 @@
          compiler/find-exe
          pkg/lib)
 
+(module test racket/base) ; disable for DrDr
+
 (unless (eq? 'user (default-pkg-scope))
   (error "Run this test with `user' default package scope"))
 

pkgs/drracket-pkgs/drracket-test/tests/drracket/randomly-click-language-dialog.rkt

@@ -1,3 +1,5 @@
 #lang racket/base
 (require "private/randomly-click.rkt")
 (go 'language-dialog)
+
+(module test racket/base)

pkgs/drracket-pkgs/drracket-test/tests/drracket/randomly-click-preferences.rkt

@@ -1,3 +1,5 @@
 #lang racket/base
 (require "private/randomly-click.rkt")
 (go 'preferences-dialog)
+
+(module test racket/base)

pkgs/drracket-pkgs/drracket-test/tests/drracket/repl-test-debug.rkt

@@ -2,3 +2,6 @@
 (require "private/repl-test.rkt" "private/drracket-test-util.rkt")
 (fire-up-drracket-and-run-tests (λ () (run-test '(debug))))
 
+(module+ test
+  (module config info
+    (define timeout 300)))

pkgs/drracket-pkgs/drracket-test/tests/drracket/repl-test-debugprofile.rkt

@@ -2,3 +2,6 @@
 (require "private/repl-test.rkt" "private/drracket-test-util.rkt")
 (fire-up-drracket-and-run-tests (λ () (run-test '(debug/profile))))
 
+(module+ test
+  (module config info
+    (define timeout 300)))

pkgs/drracket-pkgs/drracket-test/tests/drracket/repl-test-raw.rkt

@@ -2,3 +2,6 @@
 (require "private/repl-test.rkt" "private/drracket-test-util.rkt")
 (fire-up-drracket-and-run-tests (λ () (run-test '(raw))))
 
+(module+ test
+  (module config info
+    (define timeout 300)))

pkgs/drracket-pkgs/drracket-test/tests/drracket/snip/info.rkt

@@ -0,0 +1,3 @@
+#lang info
+
+(define test-omit-paths '("collapsed.rkt"))

pkgs/drracket-pkgs/drracket-test/tests/drracket/snip/run-collapsed.rkt

@@ -0,0 +1,5 @@
+#lang racket/base
+(require racket/gui/base)
+
+;; Using `racket/gui/base` installs the right load handler:
+(dynamic-require "collapsed.rkt" 0)

pkgs/drracket-pkgs/drracket-test/tests/drracket/syncheck-test.rkt

@@ -1665,3 +1665,7 @@
     (test:run-one (lambda () (send (send drs syncheck:get-button) command))))
 
   (main)
+
+(module+ test
+  (module config info
+    (define timeout 200)))

pkgs/drracket-pkgs/drracket-test/tests/drracket/test-engine-test.rkt

@@ -519,3 +519,7 @@
   (go test-disabling-tests))
 
 (fire-up-drracket-and-run-tests run-test)
+
+(module+ test
+  (module config info
+    (define timeout 480)))

pkgs/drracket-pkgs/drracket-test/tests/jpr/info.rkt

@@ -0,0 +1,3 @@
+#lang info
+
+(define test-skip-paths '("balle-grav-frot.ss"))

pkgs/drracket-pkgs/drracket-test/tests/jpr/monte-carlo.ss

@@ -49,3 +49,5 @@
                    (send CANVAS on-paint)))))
 
 (send FRAME show #t)
+
+(module test racket/base)

pkgs/drracket-pkgs/drracket/drracket/drracket.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require racket/gui/base "private/key.rkt")
 
+(module test racket/base)
+
 (define debugging? (getenv "PLTDRDEBUG"))
 (define profiling? (getenv "PLTDRPROFILE"))
 

pkgs/drracket-pkgs/drracket/drracket/main.rkt

@@ -1,2 +1,4 @@
 #lang racket/base
 (require "drracket.rkt")
+
+(module test racket/base)

pkgs/drracket-pkgs/drracket/drracket/private/drracket-normal.rkt

@@ -12,6 +12,8 @@
          "frame-icon.rkt"
          "eb.rkt")
 
+(module test racket/base)
+
 (define-runtime-path doc-icon.rkt "dock-icon.rkt")
 
 (define files-to-open (command-line #:args filenames filenames))

pkgs/drracket-pkgs/drracket/drracket/private/launcher-mred-bootstrap.rkt

@@ -1,5 +1,7 @@
 #lang racket/base
 
+(module test racket/base)
+
 (require racket/gui/base "launcher-bootstrap.rkt")
 
 (current-namespace (make-gui-empty-namespace))

pkgs/drracket-pkgs/drracket/drracket/private/launcher-mz-bootstrap.rkt

@@ -1,5 +1,7 @@
 #lang racket/base
 
+(module test racket/base)
+
 (require "launcher-bootstrap.rkt")
 
 (current-namespace (make-base-empty-namespace))

pkgs/drracket-pkgs/drracket/drracket/private/stick-figures.rkt

@@ -2,6 +2,8 @@
   (require racket/class
            racket/pretty
            racket/gui/base)
+
+  (module test racket/base)
   
   (define head-size 40)
   (define small-bitmap-factor 1/2)

pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt

@@ -6,6 +6,8 @@ the main unit, starting up DrRacket. After that, it just provides
 all of the names in the tools library, for use defining keybindings
 |#
 
+(module test racket/base)
+
 (require racket/class
          racket/gui/base
          racket/unit 

pkgs/drracket-pkgs/drracket/drscheme/drscheme.rkt

@@ -1,2 +1,3 @@
 #lang racket/base
 (require drracket/drracket)
+(module test racket/base)

pkgs/drracket-pkgs/drracket/drscheme/main.rkt

@@ -1,2 +1,3 @@
 #lang racket/base
 (require "drscheme.rkt")
+(module test racket/base)

pkgs/drracket-pkgs/drracket/drscheme/tool-lib.rkt

@@ -1,3 +1,4 @@
 #lang racket/base
 (require drracket/tool-lib)
 (provide (all-from-out drracket/tool-lib))
+(module test racket/base)

pkgs/drracket-pkgs/drracket/scribble/tools/drracket-buttons.rkt

@@ -10,6 +10,8 @@
 
 (provide drracket-buttons)
 
+(module test racket/base)
+
 (define-runtime-path pdf-png-path "pdf.png")
 (define-runtime-path html-png-path "html.png")
 (define pdf.png (make-object bitmap% pdf-png-path 'png/mask))

pkgs/drracket-pkgs/drracket/scribble/tools/private/mk-drs-bitmaps.rkt

@@ -69,3 +69,10 @@
 (match (current-command-line-arguments)
  [(vector "skip") (void)]
  [_ (send f show #t)])
+
+
+;; Test mode:
+(module test racket/base
+  (require syntax/location)
+  (parameterize ([current-command-line-arguments (vector "skip")])
+    (dynamic-require (quote-module-path "..") #f)))

pkgs/drracket-pkgs/drracket/scribblings/drracket/incremental-keybindings.rkt

@@ -2,6 +2,8 @@
 
 (require drracket/tool-lib)
 
+(module test racket/base)
+
 (keybinding "c:c;c:e" (lambda (ed evt) (send-toplevel-form ed #f)))
 (keybinding "c:c;c:r" (lambda (ed evt) (send-selection ed #f)))
 (keybinding "c:c;~c:m:e" (lambda (ed evt) (send-toplevel-form ed #t)))

pkgs/errortrace-pkgs/errortrace-test/tests/errortrace/main.rkt

@@ -7,6 +7,9 @@
          "phase-1-eval.rkt"
          "begin.rkt")
 
+(module test racket/base
+  (displayln "run as program for tests"))
+
 (wrap-tests)
 
 (test do (alert-tests))

pkgs/frtime/animation.rkt

@@ -11,6 +11,8 @@
            (as-is:unchecked frtime/lang-ext lift)
            frtime/frlibs/list
            frtime/frlibs/math)
+
+  (module test racket/base)
   
   (open-graphics)
   

pkgs/frtime/gui.rkt

@@ -1,6 +1,7 @@
 (module gui frtime
-  (require
+  (require frtime/gui/fred)
-   frtime/gui/fred)
+
+  (module test racket/base)
   
   (define frame (new ft-frame% [label "GUI"] [min-height 150] [min-width 200] [shown #t]))
   

pkgs/frtime/gui/info.rkt

@@ -1,3 +1,4 @@
 #lang info
 
 (define compile-omit-paths '("demo"))
+(define test-omit-paths '("demo"))

pkgs/frtime/info.rkt

@@ -5,6 +5,7 @@
 (define name "FrTime")
 
 (define compile-omit-paths '("demos" "tests"))
+(define test-omit-paths '("demos"))
 
 (define scribblings '(("scribblings/frtime.scrbl" () (experimental 50))))
 (define deps '("srfi-lite-lib"

pkgs/games/main.rkt

@@ -117,3 +117,8 @@
     '(ok))))
 
 (send f show #t)
+
+;; For test mode, check that we can at least start,
+;; but exit right away:
+(module+ test 
+  (queue-callback (lambda () (exit )) #f))

pkgs/games/paint-by-numbers/info.rkt

@@ -3,7 +3,6 @@
 (define game "paint-by-numbers.rkt")
 (define game-set "Puzzle Games")
 (define compile-omit-paths
-  '("main.rkt"
+  '("hattori"
-    "hattori"
     "problems"
     "solution-sets"))

pkgs/games/paint-by-numbers/main.rkt

@@ -1,519 +0,0 @@
-(unit 
-  (import [GUI : GUI^]
-	  [SOLVE : SOLVE^]
-	  [fw : framework^]
-	  paint-by-numbers:problem^
-	  [all : paint-by-numbers:all-problems^]
-	  mzlib:pretty-print^
-	  mred^)
-  (export BOARD^)
-  (define default-font (send the-font-list find-or-create-font 10 'roman 'normal 'normal #f))
-  (fw:preferences:set-un/marshall 'paint-by-numbers:font
-				  (lambda (font)
-				    (list (send font get-point-size)
-					  (send font get-face)
-					  (send font get-family)
-					  (send font get-style)
-					  (send font get-weight)
-					  (send font get-underlined)))
-				  (lambda (lst) (apply (ivar the-font-list find-or-create-font) lst)))
-  (fw:preferences:set-default 'paint-by-numbers:font default-font (lambda (f) (is-a? f font%)))
-				    
-  (define problems (car all:problemss))
-
-  (define game-name "Paint by Numbers")
-  (define editor-name "Paint by Numbers Designer")
-  (define biggest-editor 35)
-
-  (define (setup-progress max)
-    (let* ([e (make-eventspace)]
-	   [f (parameterize ([current-eventspace e])
-		(make-object frame% "Solver Setup Progress"))]
-	   [g (make-object gauge% #f max f)]
-	   [counter 0])
-      (send g min-width 300)
-      (send f show #t)
-      (lambda ()
-	(set! counter (+ 1 counter))
-	(cond
-	 [(= counter max)
-	  (collect-garbage)
-	  (send f show #f)]
-	 [else 
-	  (send g set-value counter)]))))
-
-  (define show-help
-    ((require-library "show-help.rkt" "games")
-     (list "games" "paint-by-numbers")
-     "Paint by Numbers Help"))
-
-  (define (configure-font frame)
-    (let ([font (get-font-from-user
-		 "Choose a font for the labels"
-		 frame
-		 (fw:preferences:get 'paint-by-numbers:font))])
-      (when font
-	(fw:preferences:set 'paint-by-numbers:font font))))
-
-  (define (size-font inc)
-    (let ([old-font (fw:preferences:get 'paint-by-numbers:font)])
-      (fw:preferences:set 'paint-by-numbers:font
-			  (if (send old-font get-face)
-			      (send the-font-list find-or-create-font
-				    (inc (send old-font get-point-size))
-				    (send old-font get-face)
-				    (send old-font get-family)
-				    (send old-font get-style)
-				    (send old-font get-weight)
-				    (send old-font get-underlined))
-			      (send the-font-list find-or-create-font
-				    (inc (send old-font get-point-size))
-				    (send old-font get-family)
-				    (send old-font get-style)
-				    (send old-font get-weight)
-				    (send old-font get-underlined))))))
-
-  (define (add-font-items frame menu)
-    (make-object menu-item%
-      "Choose Font"
-      menu
-      (lambda x (configure-font frame)))
-    (make-object menu-item%
-      "Make Board Bigger"
-      menu
-      (lambda x (size-font add1))
-      #\b)
-    (make-object menu-item%
-      "Make Board Tinier"
-      menu
-      (lambda x (size-font sub1))
-      #\t))
-		 
-  (define generic-frame%
-    (class (fw:frame:standard-menus-mixin fw:frame:basic%) (name)
-
-      (inherit set-label get-label get-area-container)
-      (private
-	[filename #f])
-      (public
-	[update-filename
-	 (lambda (new-name)
-	   (set! filename new-name)
-
-	   (let* ([short-name (if new-name
-				  (let-values ([(_1 name _2) (split-path new-name)])
-				    name)
-				  #f)]
-		  [new-label (if short-name
-				 (format "~a - ~a" short-name name)
-				 game-name)])
-	     (unless (string=? new-label (get-label))
-	       (set-label new-label))))])
-      (public
-	[get-pbn-filename (lambda () filename)])
-
-      (public
-	[do-save void]
-	[get-canvas void])
-
-      (private
-	[save-as
-	 (lambda ()
-	   (let ([fn (put-file)])
-	     (when fn
-	       (update-filename fn)
-	       (do-save))))])
-      (rename [super-file-menu:between-new-and-open file-menu:between-new-and-open])
-
-      (override
-       [file-menu:new-string (lambda () "Puzzle")]
-       [file-menu:new
-	(lambda (_1 _2)
-	  (player))]
-       [file-menu:between-new-and-open
-	(lambda (menu)
-	  (make-object menu-item% "Design a Puzzle..." menu
-		       (lambda (_1 _2)
-			 (editor #f)))
-	  (make-object menu-item% "Design a Puzzle from a Bitmap..." menu
-		       (lambda (_1 _2)
-			 (editor #t)))
-	  (make-object separator-menu-item% menu))]
-       [file-menu:save
-	(lambda (_1 _2)
-	  (if filename
-	      (do-save)
-	      (save-as)))]
-       [file-menu:save-as
-	(lambda (_1 _2)
-	  (save-as))]
-       [file-menu:open
-	(lambda (_1 _2)
-	  (let ([fn (get-file)])
-	    (when fn
-	      (let* ([state (call-with-input-file fn read)]
-		     [type (car state)])
-		(case type
-		  [(editor)
-		   (let ([name (cadr state)]
-			 [problem
-			  (make-problem name
-					(caddr state)
-					(cadddr state)
-					(list->vector (map list->vector (car (cddddr state)))))])
-                     (editor problem))]
-		  [(player)
-		   (let ([name (cadr state)]
-			 [problem
-			  (make-problem name
-					(caddr state)
-					(cadddr state)
-					(car (cddddr state)))])
-		     (player problem (cadr (cddddr state))))]
-		  [else
-		   (message-box "Error"
-				(format "Unknown save file ~a" fn))])))))]
-
-       [edit-menu:undo
-	(lambda (_1 _2)
-	  (send (get-canvas) undo))]
-
-       [edit-menu:redo
-	(lambda (_1 _2)
-	  (send (get-canvas) redo))])
-
-      (sequence
-	(super-init name))
-      (public
-	[top-panel (make-object horizontal-panel% (get-area-container))]
-	[help-button
-	 (make-object button% "Help" top-panel (lambda (_1 _2) (show-help)))])
-      (sequence
-	(send top-panel stretchable-height #f)
-	(send top-panel set-alignment 'right 'center))))
-
-  (define pbn-frame%
-    (class generic-frame% ([_problem (car problems)])
-
-      (private
-	[problem _problem])
-
-      (inherit get-pbn-filename)
-      (override
-	[do-save
-	 (lambda ()
-	   (call-with-output-file (get-pbn-filename)
-	     (lambda (port)
-	       (pretty-print
-		(list 'player
-		      (problem-name problem)
-		      (problem-rows problem)
-		      (problem-cols problem)
-		      (problem-solution problem)
-		      (send canvas get-grid))
-		port))
-	     'truncate
-	     'text))])
-
-      (inherit can-close? show)
-
-      (inherit stretchable-width stretchable-height update-filename)
-      (private
-	[set-problem
-	 (lambda (prlmb)
-	   (update-filename #f)
-	   (send wrong-item enable (problem-solution prlmb))
-	   (send editor-item enable (problem-solution prlmb))
-	   (let ([rows (problem-rows prlmb)]
-		 [cols (problem-cols prlmb)])
-	     (set! problem prlmb)
-	     (when canvas (send canvas close-up))
-	     (set! canvas (make-object GUI:paint-by-numbers-canvas% canvas-panel rows cols))
-	     (send canvas-panel change-children (lambda (l) (list canvas))))
-	   (stretchable-width #f)
-	   (stretchable-height #f))]
-
-	[show-wrong
-	 (lambda ()
-	   (let loop ([i (length (problem-cols problem))])
-	     (unless (zero? i)
-	       (let loop ([j (length (problem-rows problem))])
-		 (unless (zero? j)
-		   (let* ([m (- i 1)]
-			  [n (- j 1)]
-			  [board-entry (get-entry m n)]
-			  [real-answer (vector-ref (vector-ref (problem-solution problem) m) n)])
-		     (unless (or (eq? board-entry real-answer)
-				 (eq? board-entry 'unknown)
-				 (eq? real-answer 'unknown))
-		       (send canvas set-to-error m n)))
-		   (loop (- j 1))))
-	       (loop (- i 1)))))]
-	
-	[get-entry
-	 (lambda (i j)
-	   (send canvas get-rect i j))]
-
-	[set-entry
-	 (lambda (i j nv)
-	   (send canvas set-rect i j nv)
-	   (send canvas paint-rect i j))]
-
-	[really-solve?
-	 (lambda ()
-	   (fw:gui-utils:get-choice
-	    (format "~
-  Solving can be a very computationally intense task;~
-\nyou may run out of memory and crash. ~
-\nReally continue? (Be sure to save your work!)")
-	    "Yes"
-	    "No"
-	    "Really Solve?"
-	    #f))]
-
-	[solve
-	 (lambda ()
-	   (when (really-solve?)
-	     (send canvas all-unknown)
-	     (send canvas on-paint)
-	     (SOLVE:solve
-	      (problem-rows problem)
-	      (problem-cols problem)
-	      set-entry
-	      setup-progress)))])
-
-      (sequence
-	(super-init game-name))
-
-      (private
-	[wrong-item #f]
-	[solve-item #f]
-	[editor-item #f])
-      (inherit get-menu-bar)
-      (sequence
-	(let* ([mb (get-menu-bar)]
-	       [pbn-menu (make-object menu% "Nonogram" mb)])
-	  (set! solve-item (make-object menu-item% "Solve" pbn-menu
-					(lambda (_1 _2)
-					  (solve))
-					#\l))
-	  (set! wrong-item (make-object menu-item% "Show Mistakes" pbn-menu
-					(lambda (_1 _2)
-					  (show-wrong)) #\h))
-	  (set! editor-item (make-object menu-item% "Edit this Puzzle" pbn-menu
-					 (lambda (_1 _2)
-					   (editor problem))))
-
-	  (make-object separator-menu-item% pbn-menu)
-	  (add-font-items this pbn-menu)))
-
-      (inherit top-panel help-button get-area-container)
-      (private
-	[gap (make-object horizontal-panel% top-panel)]
-	[set-choice
-	 (make-object choice%
-		      "Set"
-		      all:set-names
-		      top-panel
-		      (lambda (choice evt)
-			(set! problems (list-ref all:problemss (send choice get-selection)))
-			(send board-choice clear)
-			(for-each (lambda (problem) (send board-choice append (problem-name problem)))
-				  problems)
-			(set-problem (car problems))))]
-	[board-choice (make-object choice%
-				   "Board"
-				   (map problem-name problems)
-				   top-panel
-				   (lambda (choice evt)
-				     (set-problem (list-ref problems (send choice get-selection)))))]
-	[canvas/spacer-panel (make-object horizontal-panel% (get-area-container))]
-	[canvas-panel (make-object vertical-pane% canvas/spacer-panel)]
-	[spacer (make-object grow-box-spacer-pane% canvas/spacer-panel)]
-	[canvas #f])
-      (sequence
-	(send top-panel change-children (lambda (l) (list set-choice board-choice gap help-button))))
-
-      (override
-	[get-canvas
-	 (lambda ()
-	   canvas)])
-
-      (rename [super-on-close on-close])
-      (override
-       [on-close
-	(lambda ()
-	  (when canvas (send canvas close-up)))])
-
-      (sequence
-	(set-problem problem)
-	(show #t))))
-
-  (define editor-frame%
-    (class generic-frame% (indicator)
-      (inherit get-pbn-filename)
-      (override
-       [do-save
-	(lambda ()
-	  (let ([fn (get-pbn-filename)])
-	    (call-with-output-file fn
-	      (lambda (port)
-		(pretty-print
-		 (list 'editor
-		       (let-values ([(base name dir?) (split-path fn)])
-			 name)
-		       (send canvas get-row-numbers)
-		       (send canvas get-col-numbers)
-		       (let ([grid (send canvas get-grid)])
-			 (map (lambda (l) (map (lambda (x) (if (eq? x 'on) 'on 'off)) l)) grid)))
-		 port))
-	      'truncate
-	      'text)))])
-
-      (private
-	[test-puzzle
-	 (lambda ()
-	   (player
-	    (make-problem "<editor test>"
-			  (send canvas get-row-numbers)
-			  (send canvas get-col-numbers)
-			  (send canvas get-grid))))])
-
-      (private
-	[canvas #f])
-      (override
-	[get-canvas
-	 (lambda ()
-	   canvas)])
-
-
-      (rename [super-on-close on-close])
-      (override
-       [on-close
-	(lambda ()
-	  (when canvas (send canvas close-up))
-	  (super-on-close))])
-
-      (sequence
-	(super-init editor-name))
-
-      (inherit get-area-container)
-      (private
-	[space/canvas-panel (make-object horizontal-panel% (get-area-container))]
-	[canvas-panel (make-object vertical-pane% space/canvas-panel)]
-	[spacer (make-object grow-box-spacer-pane% canvas-panel)])
-
-      (sequence
-	(cond
-	 [(pair? indicator)
-	  (when canvas
-	    (send canvas close-up))
-	  (set! canvas
-		  (make-object GUI:design-paint-by-numbers-canvas%
-		    canvas-panel
-		    (car indicator)
-		    (cdr indicator)))]
-	 [(is-a? indicator bitmap%)
-	  (when canvas
-	    (send canvas close-up))
-	  (set! canvas
-		(make-object GUI:design-paint-by-numbers-canvas%
-		  canvas-panel
-		  (min biggest-editor (send indicator get-width))
-		  (min biggest-editor (send indicator get-height))))
-	  (when (or (> (send indicator get-width) biggest-editor)
-		    (> (send indicator get-height) biggest-editor))
-	    (message-box
-	     "Paint by Numbers"
-	     (format "WARNING: Bitmap is larger than ~ax~a. Truncating."
-		     biggest-editor biggest-editor)))
-	  (send canvas set-bitmap indicator)]
-	 [(problem? indicator)
-	  (when canvas
-	    (send canvas close-up))
-	  (set! canvas
-		(make-object GUI:design-paint-by-numbers-canvas%
-		  canvas-panel
-		  (length (problem-cols indicator))
-		  (length (problem-rows indicator))))
-	  (send canvas set-grid
-		(map vector->list (vector->list (problem-solution indicator))))]))
-
-      (inherit get-menu-bar)
-      (sequence
-	(let* ([mb (get-menu-bar)]
-	       [pbn-menu (make-object menu% "Nonogram" mb)])
-	  (make-object menu-item% "Test Puzzle" pbn-menu (lambda (_1 _2) (test-puzzle)))
-
-	  (make-object separator-menu-item% pbn-menu)
-	  (add-font-items this pbn-menu)))))
-
-  (define (editor bitmap?)
-    (let* ([default 15]
-	   [get-sizes
-	    (lambda ()
-	      (let* ([d (make-object dialog% "Size")]
-		     [m (make-object message% "How big should the designer be?" d)]
-		     [wp (make-object horizontal-panel% d)]
-		     [wm (make-object message% "Width" wp)]
-		     [gw (make-object slider% #f 1 biggest-editor wp void default)]
-		     [hp (make-object horizontal-panel% d)]
-		     [hm (make-object message% "Height" hp)]
-		     [gh (make-object slider% #f 1 biggest-editor hp void default)]
-		     [bp (make-object horizontal-panel% d)]
-		     [cancelled? #f]
-		     [cancel (make-object button% "Cancel" bp (lambda (_1 _2)
-								(set! cancelled? #t)
-								(send d show #f)))]
-		     [ok (make-object button% "OK" bp (lambda (_1 _2) (send d show #f)) '(border))])
-
-		(let ([label-width (max (send wm get-width)
-					(send hm get-width))])
-		  (send wm min-width label-width)
-		  (send hm min-width label-width))
-
-		(send bp set-alignment 'right 'center)
-      
-		(send d show #t)
-		(if cancelled?
-		    #f
-		    (cons (send gw get-value)
-			  (send gh get-value)))))]
-	   [get-bitmap
-	    (lambda ()
-	      (let* ([fn (get-file "Select a bitmap")]
-		     [bm (make-object bitmap% fn)])
-		(if (send bm ok?)
-		    bm
-		    (begin
-		      (message-box
-		       "Paint by Numbers"
-		       (format (format "Unreadable file: ~a" fn)))
-		      #f))))]
-	   [indicator
-	    (cond
-	     [(boolean? bitmap?)
-	      (if bitmap?
-		  (get-bitmap)
-		  (get-sizes))]
-	     [(problem? bitmap?)
-	      bitmap?])])
-		
-      (when indicator
-	(send (make-object editor-frame% indicator) show #t))))
-
-  (define player
-    (case-lambda
-     [() (player (car problems))]
-     [(problem)
-      (let ([f (make-object pbn-frame% problem)])
-	(send f show #t))]
-     [(problem state)
-      (let ([f (make-object pbn-frame% problem)])
-	(send (send f get-canvas) set-grid state)
-	(send f show #t))]))
-
-  (player)
-  ;(editor #f)
-
-  (yield (make-semaphore)))

pkgs/games/paint-by-numbers/raw-problems/build-final.rkt

@@ -10,6 +10,8 @@ in ...
 
 |#
 
+(module test racket/base)
+
 ;; shrink-file : string -> string
 (define (shrink-file filename)
   (printf "shrinking ~a..." filename)

pkgs/games/paint-by-numbers/raw-problems/build-rows-cols.rkt

@@ -3,6 +3,8 @@
          racket/class)
 (define argv (current-command-line-arguments))
 
+(module test racket/base)
+
 (when (equal? (vector) argv)
   (error 'build-rows-cols.rkt
          "expected an image file on the command-line"))

pkgs/games/parcheesi/make-bitmap.rkt

@@ -3,6 +3,8 @@
            racket/gui
            racket/class)
 
+  (module test racket/base)
+
   (provide show-board
            board-canvas%
            draw-board
@@ -547,7 +549,7 @@
           (resize-bitmap))
         ;(send (get-dc) draw-bitmap buffer 0 0)
         (let ([dc (get-dc)])
-          (send dc set-anti-alias #t)
+          (send dc set-smoothing 'smoothed)
           (draw-board board dc 32 32 0 0 #t)))
       
       (define/override (on-size w h)

pkgs/gui-pkgs/gui-lib/embedded-gui/private/tests/info.rkt

@@ -1,3 +1,4 @@
 #lang info
 
 (define compile-omit-paths 'all)
+(define test-omit-paths 'all)

pkgs/gui-pkgs/gui-lib/mred/edit-main.rkt

@@ -5,6 +5,8 @@
   (require "edit.rkt"
            mzlib/cmdline)
 
+  (module test racket/base)
+
   (command-line
    "Edit"
    (current-command-line-arguments)

pkgs/gui-pkgs/gui-lib/mred/private/wx/info.rkt

@@ -0,0 +1,3 @@
+#lang info
+
+(define test-omit-paths 'all)

pkgs/gui-pkgs/gui-lib/mrlib/private/aligned-pasteboard/tests/info.rkt

@@ -0,0 +1,15 @@
+#lang info
+
+(define test-omit-paths '("example-min.rkt"
+                          "example.rkt"
+                          "minimal.rkt"
+                          "more-tests-margin-aligned.rkt"
+                          "more-tests-margin.rkt"
+                          "more-tests-min-stretchable.rkt"
+                          "more-tests-min.rkt"
+                          "more-tests-text.rkt"
+                          "more-tests.rkt"
+                          "old-bugs"
+                          "stretchable-editor-snip-test-min.rkt"
+                          "stretchable-editor-snip-test.rkt"
+                          "test-locked-pasteboard.rkt"))

pkgs/gui-pkgs/gui-test/framework/tests/canvas.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
 
+(module test racket/base)
+
 (define (test-creation class name)
   (test
    name

pkgs/gui-pkgs/gui-test/framework/tests/debug.rkt

@@ -2,6 +2,8 @@
 (require (for-syntax racket/base))
 (provide debug-printf debug-when)
 
+(module test racket/base)
+
 ;; all of the steps in the tcp connection
 (define mz-tcp? #f)
 (define mr-tcp? mz-tcp?)

pkgs/gui-pkgs/gui-test/framework/tests/exit.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
 
+(module test racket/base)
+
 (test 'exit/no-prompt
       (lambda (x)
 	(and (eq? x 'passed)

pkgs/gui-pkgs/gui-test/framework/tests/frame.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 
   (require "test-suite-utils.rkt")
+
+  (module test racket/base)
   
   (send-sexp-to-mred '(send (make-object frame:basic%
                               "dummy to keep from quitting")

pkgs/gui-pkgs/gui-test/framework/tests/framework-test-engine.rkt

@@ -5,6 +5,8 @@
          racket/gui/base
          "debug.rkt")
 
+(module test racket/base)
+
 (define errs null)
 (define sema (make-semaphore 1))
 (define (protect f)

pkgs/gui-pkgs/gui-test/framework/tests/group-test.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
 
+(module test racket/base)
+
 (define windows-menu-prefix 
   (let ([basics (list "Bring Frame to Front..." "Most Recent Window" 
                       #f)])

pkgs/gui-pkgs/gui-test/framework/tests/handler-test.rkt

@@ -1,6 +1,8 @@
 (module handler-test mzscheme
   (require "test-suite-utils.rkt")
 
+(module test racket/base)
+
 (let* ([filename "framework-group-test.rkt"]
        [tmp-filename (build-path (find-system-path 'temp-dir) filename)])
 

pkgs/gui-pkgs/gui-test/framework/tests/keys.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 
 (require "test-suite-utils.rkt")
+
+(module test racket/base)
   
   (test
    'keymap:aug-keymap%/get-table

pkgs/gui-pkgs/gui-test/framework/tests/load.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
 
+(module test racket/base)
+
   (load-framework-automatically #f)
 
   (define (test/load file exp)

pkgs/gui-pkgs/gui-test/framework/tests/main.rkt

@@ -118,3 +118,7 @@
                               (car failed-test) (cdr failed-test)))
                    failed-tests)
          1]))
+
+(module+ test
+  (module config info
+    (define timeout 360)))

pkgs/gui-pkgs/gui-test/framework/tests/mem.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
 
+(module test racket/base)
+
 ; mem-boxes : (list-of (list string (list-of (weak-box TST))))
 (send-sexp-to-mred '(define mem-boxes null))
 

pkgs/gui-pkgs/gui-test/framework/tests/panel-single.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
 
+(module test racket/base)
+
 (test 
  'single-panel
  (lambda (x) (eq? x 'passed))

pkgs/gui-pkgs/gui-test/framework/tests/panel.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
 
+(module test racket/base)
+
 (test
  'dragable-min-size1
  (λ (min-w/min-h) (equal? min-w/min-h '(10 20)))

pkgs/gui-pkgs/gui-test/framework/tests/pasteboard.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
 
+(module test racket/base)
+
 (define (test-creation frame class name)
   (test
    name

pkgs/gui-pkgs/gui-test/framework/tests/prefs.rkt

@@ -1,5 +1,7 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
+
+(module test racket/base)
   
   (define ((check-equal? x) y) (equal? x y))
   (define pref-sym 'plt:not-a-real-preference)

pkgs/gui-pkgs/gui-test/framework/tests/search.rkt

@@ -2,6 +2,8 @@
 (require (for-syntax racket/base)
          "test-suite-utils.rkt")
 
+(module test racket/base)
+
 (define-syntax (test-search stx)
   (syntax-case stx ()
     [(_ args ...)

pkgs/gui-pkgs/gui-test/framework/tests/text.rkt

@@ -3,6 +3,8 @@
 (require racket/file
          "test-suite-utils.rkt")
 
+(module test racket/base)
+
 (define dummy-frame-title "dummy to avoid quitting")
 (queue-sexp-to-mred `(send (make-object frame:basic% ,dummy-frame-title) show #t))
 

pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt

@@ -1476,3 +1476,8 @@
                      (send canvas refresh)))))
 
   (send f show #t))
+
+;; For test mode, check that we can at least start,
+;; but exit right away:
+(module+ test 
+  (queue-callback (lambda () (exit)) #f))

pkgs/gui-pkgs/gui-test/tests/gracket/info.rkt

@@ -0,0 +1,8 @@
+#lang info
+
+(define test-omit-paths '("blits.rkt"
+                          "flush-stress.rkt"
+                          "mem.rkt"
+                          "showkey.rkt"
+                          "unflushed-circle.rkt"
+                          "wxme-random.rkt"))

pkgs/gui-pkgs/gui-test/tests/gracket/item.rkt

@@ -2594,3 +2594,8 @@
 (make-selector-and-runner mp1 mp2 #f #f "Medium" med-frame)
 
 (send selector show #t)
+
+;; For test mode, check that we can at least start,
+;; but exit right away:
+(module+ test 
+  (queue-callback (lambda () (exit)) #f))

pkgs/gui-pkgs/gui-test/tests/gracket/wxme-doc-random.rkt

@@ -1,169 +0,0 @@
-#lang scheme/gui
-
-(define (find sym l)
-  (cond
-   [(null? l) null]
-   [(and (pair? (car l))
-         (eq? sym (caar l)))
-    (car l)]
-   [else (find sym (cdr l))]))
-
-(define (add-method s table)
-  (let* ([s (if (keyword? (cadr s))
-                (cddr s)
-                s)]
-         [name (caadr s)]
-         [args (map cadr (cdadr s))])
-    (cons (cons name args)
-          table)))
-
-(define (read-methods path kind table)
-  (let ([s (call-with-input-file* path (lambda (in)
-                                         (parameterize ([read-accept-reader #t])
-                                           (read in))))])
-    (for/fold ([table table])
-        ([s (in-list (find kind s))])
-      (if (pair? s)
-          (cond
-           [(eq? (car s) 'defmethod)
-            (add-method s table)]
-           [else table])
-          table))))
-
-(define editor-methods
-  (read-methods (build-path (collection-path "scribblings" "gui")
-                            "editor-intf.scrbl")
-                'definterface/title
-                null))
-
-(define (delete l l2)
-  (if (null? l)
-      l2
-      (delete (cdr l) (filter (lambda (p) (not (eq? (car l) (car p)))) l2))))
-
-(define text-methods
-  (list->vector
-   (delete
-    '(read-header-from-file read-footer-from-file read-from-file
-                            end-write-header-footer-to-file)
-    (read-methods (build-path (collection-path "scribblings" "gui")
-                              "text-class.scrbl")
-                  'defclass/title
-                  (delete '(do-paste-x-selection do-paste do-copy) editor-methods)))))
-
-;; ----------------------------------------
-
-(define bm-dc
-  (let ([bm (make-object bitmap% 10 10)])
-    (make-object bitmap-dc% bm)))
-(define frame
-  (new frame% [label "Test"]))
-(define canvas
-  (new editor-canvas% [parent frame]))
-
-(define (generate-args contract-expr)
-  (if (pair? contract-expr)
-      (case (car contract-expr)
-        [(or/c one-of/c) (generate-args
-                          (list-ref
-                           (cdr contract-expr)
-                           (random (length (cdr contract-expr)))))]
-        [(and/c)
-         (cond
-          [(equal? contract-expr '(and/c exact? integer?))
-           (generate-args 'exact-integer?)]
-          [(equal? contract-expr '(and/c real? (not/c negative?)))
-           (random-elem '#(0.0 1.0 100.0 1000.0))]
-          [else (error "unknown" contract-expr)])]
-        [(box/c) `(box ,(generate-args (cadr contract-expr)))]
-        [(listof) (case (random 3)
-                    [(0) 'null]
-                    [(1) (list 'list
-                               (generate-args (cadr contract-expr)))]
-                    [(2) (list 'list
-                               (generate-args (cadr contract-expr))
-                               (generate-args (cadr contract-expr)))])]
-        [(quote)
-         `(quote ,(cadr contract-expr))]
-        [(is-a?/c)
-         (case (cadr contract-expr)
-           [(editor-stream-out%)
-            (make-object editor-stream-out% (make-object editor-stream-out-bytes-base%))]
-           [(editor-stream-in%)
-            (make-object editor-stream-in% (make-object editor-stream-in-bytes-base% #""))]
-           [(snip%)
-            (let ([s (make-object string-snip%)])
-              (send s insert "hi" 2)
-              s)]
-           [(mouse-event%)
-            (make-object mouse-event% 'motion)]
-           [(key-event%)
-            (make-object key-event%)]
-           [(editor-data%) (new editor-data%)]
-           [(text%) (new text%)]
-           [(pasteboard%) (new pasteboard%)]
-           [(cursor%) (make-object cursor% 'arrow)]
-           [(style-delta%) (new style-delta%)]
-           [(style-list%) (new style-list%)]
-           [(style<%>) (send (new style-list%) basic-style)]
-           [(editor-canvas%) canvas]
-           [(frame% dialog%) frame]
-           [(dc<%>) bm-dc]
-           [(editor-admin%) (send t get-admin)]
-           [(bitmap%) (make-object bitmap% 10 10)]
-           [(color%) (new color%)]
-           [(keymap%) (new keymap%)]
-           [(editor-wordbreak-map%) (new editor-wordbreak-map%)]
-           [else (error "unknown" contract-expr)])]
-        [(->) void]
-        [else (error "unknown" contract-expr)])
-      (case contract-expr
-        [(any/c) #f]
-        [(path?) (string->path "/tmp/foo")]
-        [(path-string?) "/tmp/foo"]
-        [(input-port?) (open-input-bytes #"")]
-        [(output-port?) (open-output-bytes)]
-        [(real?)
-         (random-elem '#(0.0 1.0 -1.0 100.0 -100.0))]
-        [(exact-nonnegative-integer?)
-         (random-elem '#(0 1 2 10 100 1000))]
-        [(exact-integer?)
-         (random-elem '#(0 1 -1 2 10 -10 100 1000))]
-        [(string?)
-         (random-elem '#("a" "hello" ""))]
-        [(#f) #f]
-        [(#t) #t]
-        [else (error "unknown" contract-expr)])))
-
-(define (random-elem v)
-  (vector-ref v (random (vector-length v))))
-
-;; ----------------------------------------
-
-(define t (new text%))
-
-; (send t copy-self)
-; (send t begin-write-header-footer-to-file (generate-args '(is-a?/c editor-stream-out%)) "" (box 0))
-; is-printing?
-; #f for set-keymap
-; seqcontract print
-; undo error
-; get-character
-; blink-caret & no admin
-; move-position & no admin
-
-(define-namespace-anchor a)
-
-(let ([n (abs (current-milliseconds))])
-  (printf "~s\n" n)
-  (random-seed n))
-
-(parameterize ([current-namespace (namespace-anchor->namespace a)])
-  (let loop ()
-    (let ([m (random-elem text-methods)])
-      (let ([name (car m)]
-            [args (map generate-args (cdr m))])
-        (printf "Call ~s\n" (cons name args))
-        (eval `(send ,t ,(car m) ,@args))
-        (loop)))))
-

pkgs/htdp-pkgs/htdp-lib/2htdp/info.rkt

@@ -1,3 +1,7 @@
 #lang info
 
 (define name "HtDP/2e Teachpacks")
+
+(define test-omit-paths '("uchat/chatter.rkt"
+                          "uchat/server.rkt"))
+

pkgs/htdp-pkgs/htdp-lib/graphics/turtle-test.rkt

@@ -5,6 +5,8 @@
            "turtle-examples.rkt"
            "turtles.rkt")
 
+  (module test racket/base)
+
   (define frame (make-object frame% "Turtle Examples"))
   
   (define options

pkgs/htdp-pkgs/htdp-lib/graphics/value-turtles-test.rkt

@@ -3,6 +3,8 @@
            "value-turtles.rkt"
            mred
            mzlib/class)
+
+  (module test racket/base)
   
   (define-syntax (test stx)
     (syntax-case stx ()

pkgs/htdp-pkgs/htdp-lib/htdp/graphing.rkt

@@ -14,6 +14,8 @@
  graph-line
  )
 
+(module test racket/base)
+
 (define-higher-order-primitive graph-line graph-line/proc (f _))
 (define-higher-order-primitive graph-fun graph-fun/proc (f _))
 

pkgs/htdp-pkgs/htdp-lib/teachpack/htdp/graphing.rkt

@@ -1,3 +1,4 @@
 #lang racket/base
 (require htdp/graphing)
 (provide (all-from-out htdp/graphing))
+(module test racket/base)

pkgs/htdp-pkgs/htdp-test/2htdp/tests/info.rkt

@@ -0,0 +1,16 @@
+#lang info
+
+(define test-omit-paths
+  '("jpr-bug.rkt"
+    "mouse-evt.rkt"
+    "mp.rkt"
+    "perform-whack.rkt"
+    "profile-robby.rkt"
+    "dir.rkt"
+    "matrix-client.rkt"
+    "matrix-example.rkt"
+    "jump-to-ui-test.rkt"
+    "on-release-no-key.rkt"
+    "pad1.rkt"
+    "universe-receive.rkt"
+    "batch-io-xexpr.rkt"))

pkgs/htdp-pkgs/htdp-test/2htdp/utest/info.rkt

@@ -0,0 +1,4 @@
+#lang info
+
+(define test-omit-paths
+  '("sam.rkt"))