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

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

Browse Source 
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
This commit is contained in:
Matthew Flatt 2013-12-29 10:29:19 -06:00
parent 4a19403288
commit e226ad66c5
233 changed files with 1758 additions and 2063 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/cext-lib/compiler/commands/ctool.rkt
View File

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

2
pkgs/compiler-pkgs/compiler-lib/compiler/commands/exe-dir.rkt
View File

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

2
pkgs/compiler-pkgs/compiler-lib/compiler/commands/exe.rkt
View File

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

2
pkgs/compiler-pkgs/compiler-lib/compiler/commands/make.rkt
View File

@ -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))

1
pkgs/compiler-pkgs/compiler-lib/compiler/commands/pack.rkt
View File

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

2
pkgs/compiler-pkgs/compiler-lib/compiler/demodularizer/batch.rkt
View File

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

5
pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me9.rkt
View File

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

4
pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/info.rkt
View File

@ -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"))

2
pkgs/compiler-pkgs/compiler-test/tests/compiler/zo-test-worker.rkt
View File

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

6
pkgs/compiler-pkgs/compiler-test/tests/compiler/zo-test.rkt
View File

@ -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)))

2
pkgs/db-pkgs/db-test/tests/db/programs/web-test.rkt
View File

@ -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

2
pkgs/deinprogramm/deinprogramm/run-dmda-code.rkt
View File

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

2
pkgs/distro-build/add-catalog.rkt
View File

@ -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))

2
pkgs/distro-build/assemble-site.rkt
View File

@ -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"))

2
pkgs/distro-build/drive-clients.rkt
View File

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

2
pkgs/distro-build/install-for-docs.rkt
View File

@ -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

2
pkgs/distro-build/install-pkgs.rkt
View File

@ -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

2
pkgs/distro-build/installer.rkt
View File

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

2
pkgs/distro-build/manage-snapshots.rkt
View File

@ -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"))

2
pkgs/distro-build/pack-and-catalog.rkt
View File

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

2
pkgs/distro-build/pack-built.rkt
View File

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

2
pkgs/distro-build/pack-collects.rkt
View File

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

2
pkgs/distro-build/serve-catalog.rkt
View File

@ -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

2
pkgs/distro-build/set-config.rkt
View File

@ -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)

2
pkgs/distro-build/unpack-collects.rkt
View File

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

3
pkgs/drracket-pkgs/drracket-test/tests/drracket/io.rkt
View File

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

4
pkgs/drracket-pkgs/drracket-test/tests/drracket/language-test.rkt
View File

@ -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)))

9
pkgs/drracket-pkgs/drracket-test/tests/drracket/module-lang-test.rkt
View File

@ -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)))

2
pkgs/drracket-pkgs/drracket-test/tests/drracket/populate-compiled.rkt
View File

@ -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"))

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

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

2
pkgs/drracket-pkgs/drracket-test/tests/drracket/randomly-click-preferences.rkt
View File

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

3
pkgs/drracket-pkgs/drracket-test/tests/drracket/repl-test-debug.rkt
View File

@ -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)))

3
pkgs/drracket-pkgs/drracket-test/tests/drracket/repl-test-debugprofile.rkt
View File

@ -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)))

3
pkgs/drracket-pkgs/drracket-test/tests/drracket/repl-test-raw.rkt
View File

@ -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)))

3
pkgs/drracket-pkgs/drracket-test/tests/drracket/snip/info.rkt Normal file
View File

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

5
pkgs/drracket-pkgs/drracket-test/tests/drracket/snip/run-collapsed.rkt Normal file
View File

@ -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)

4
pkgs/drracket-pkgs/drracket-test/tests/drracket/syncheck-test.rkt
View File

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

4
pkgs/drracket-pkgs/drracket-test/tests/drracket/test-engine-test.rkt
View File

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

3
pkgs/drracket-pkgs/drracket-test/tests/jpr/info.rkt Normal file
View File

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

2
pkgs/drracket-pkgs/drracket-test/tests/jpr/monte-carlo.ss
View File

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

2
pkgs/drracket-pkgs/drracket/drracket/drracket.rkt
View File

@ -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"))

2
pkgs/drracket-pkgs/drracket/drracket/main.rkt
View File

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

2
pkgs/drracket-pkgs/drracket/drracket/private/drracket-normal.rkt
View File

@ -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))

2
pkgs/drracket-pkgs/drracket/drracket/private/launcher-mred-bootstrap.rkt
View File

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

2
pkgs/drracket-pkgs/drracket/drracket/private/launcher-mz-bootstrap.rkt
View File

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

2
pkgs/drracket-pkgs/drracket/drracket/private/stick-figures.rkt
View File

@ -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)

2
pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt
View File

@ -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

1
pkgs/drracket-pkgs/drracket/drscheme/drscheme.rkt
View File

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

1
pkgs/drracket-pkgs/drracket/drscheme/main.rkt
View File

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

1
pkgs/drracket-pkgs/drracket/drscheme/tool-lib.rkt
View File

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

2
pkgs/drracket-pkgs/drracket/scribble/tools/drracket-buttons.rkt
View File

@ -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))

BIN
pkgs/drracket-pkgs/drracket/scribble/tools/html.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 908 B

After

Width:  |  Height:  |  Size: 723 B

BIN
pkgs/drracket-pkgs/drracket/scribble/tools/pdf.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 858 B

After

Width:  |  Height:  |  Size: 711 B

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

@ -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)))

2
pkgs/drracket-pkgs/drracket/scribblings/drracket/incremental-keybindings.rkt
View File

@ -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)))

3
pkgs/errortrace-pkgs/errortrace-test/tests/errortrace/main.rkt
View File

@ -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))

2
pkgs/frtime/animation.rkt
View File

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

5
pkgs/frtime/gui.rkt
View File

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

1
pkgs/frtime/gui/info.rkt
View File

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

1
pkgs/frtime/info.rkt
View File

@ -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"

5
pkgs/games/main.rkt
View File

@ -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))

3
pkgs/games/paint-by-numbers/info.rkt
View File

@ -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"))

519
pkgs/games/paint-by-numbers/main.rkt
View File

@ -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)))

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

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

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

@ -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"))

4
pkgs/games/parcheesi/make-bitmap.rkt
View File

@ -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)

BIN
pkgs/games/parcheesi/parcheesi.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 521 B

After

Width:  |  Height:  |  Size: 500 B

1
pkgs/gui-pkgs/gui-lib/embedded-gui/private/tests/info.rkt
View File

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

2
pkgs/gui-pkgs/gui-lib/mred/edit-main.rkt
View File

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

3
pkgs/gui-pkgs/gui-lib/mred/private/wx/info.rkt Normal file
View File

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

15
pkgs/gui-pkgs/gui-lib/mrlib/private/aligned-pasteboard/tests/info.rkt Normal file
View File

@ -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"))

2
pkgs/gui-pkgs/gui-test/framework/tests/canvas.rkt
View File

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

2
pkgs/gui-pkgs/gui-test/framework/tests/debug.rkt
View File

@ -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?)

2
pkgs/gui-pkgs/gui-test/framework/tests/exit.rkt
View File

@ -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)

2
pkgs/gui-pkgs/gui-test/framework/tests/frame.rkt
View File

@ -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")

2
pkgs/gui-pkgs/gui-test/framework/tests/framework-test-engine.rkt
View File

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

2
pkgs/gui-pkgs/gui-test/framework/tests/group-test.rkt
View File

@ -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)])

2
pkgs/gui-pkgs/gui-test/framework/tests/handler-test.rkt
View File

@ -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)])

2
pkgs/gui-pkgs/gui-test/framework/tests/keys.rkt
View File

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

2
pkgs/gui-pkgs/gui-test/framework/tests/load.rkt
View File

@ -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)

4
pkgs/gui-pkgs/gui-test/framework/tests/main.rkt
View File

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

2
pkgs/gui-pkgs/gui-test/framework/tests/mem.rkt
View File

@ -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))

2
pkgs/gui-pkgs/gui-test/framework/tests/panel-single.rkt
View File

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

2
pkgs/gui-pkgs/gui-test/framework/tests/panel.rkt
View File

@ -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)))

2
pkgs/gui-pkgs/gui-test/framework/tests/pasteboard.rkt
View File

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

2
pkgs/gui-pkgs/gui-test/framework/tests/prefs.rkt
View File

@ -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)

2
pkgs/gui-pkgs/gui-test/framework/tests/search.rkt
View File

@ -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 ...)

2
pkgs/gui-pkgs/gui-test/framework/tests/text.rkt
View File

@ -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))

5
pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt
View File

@ -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))

8
pkgs/gui-pkgs/gui-test/tests/gracket/info.rkt Normal file
View File

@ -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"))

5
pkgs/gui-pkgs/gui-test/tests/gracket/item.rkt
View File

@ -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))

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

@ -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)))))

4
pkgs/htdp-pkgs/htdp-lib/2htdp/info.rkt
View File

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

2
pkgs/htdp-pkgs/htdp-lib/graphics/turtle-test.rkt
View File

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

2
pkgs/htdp-pkgs/htdp-lib/graphics/value-turtles-test.rkt
View File

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

2
pkgs/htdp-pkgs/htdp-lib/htdp/graphing.rkt
View File

@ -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 _))

1
pkgs/htdp-pkgs/htdp-lib/teachpack/htdp/graphing.rkt
View File

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

16
pkgs/htdp-pkgs/htdp-test/2htdp/tests/info.rkt Normal file
View File

@ -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"))

1831
pkgs/htdp-pkgs/htdp-test/2htdp/tests/perform-record.rkt
View File

File diff suppressed because it is too large Load Diff

4
pkgs/htdp-pkgs/htdp-test/2htdp/utest/info.rkt Normal file
View File

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

Some files were not shown because too many files have changed in this diff Show More