convert ".rktl" test entry points to ".rkt"

This commit is contained in:
Matthew Flatt 2013-12-26 08:11:39 -06:00
parent 0edcbf3f82
commit f6b8f734f3
37 changed files with 191 additions and 853 deletions

View File

@ -1,13 +0,0 @@
(define (wait-for-frame name)
(let ([timeout 10]
[pause-time 1/2])
(send-sexp-to-mred
`(let loop ([n ,(/ timeout pause-time)])
(if (zero? n)
(error 'wait-for-mred-frame
,(format "after ~a seconds, frame labelled ~s didn't appear" timeout name))
(let ([win (get-top-level-focus-window)])
(printf "win: ~a label ~a\n" win (and win (string=? (send win get-label) ,name)))
(unless (and win (string=? (send win get-label) ,name))
(sleep ,pause-time)
(loop (- n 1)))))))))

View File

@ -1,89 +0,0 @@
(lambda (new-name save-name console%)
(let* ([dir (current-load-relative-directory)]
[console
(let loop ([printout? #f])
(let ([f (mred:test:get-active-frame)])
(if (and f
(is-a? f console%))
f
(begin
(unless printout?
(printf "please select the console\n"))
(sleep 1/2)
(loop #t)))))]
[wait
(lambda (test desc-string [time 5])
(let ([int 1/2])
(let loop ([sofar 0])
(cond
[(> sofar time) (error 'wait desc-string)]
[(test) (void)]
[else (sleep int)
(loop (+ sofar int))]))))]
[wait-pending
(lambda ()
(wait (lambda () (= 0 (mred:test:number-pending-actions)))
"pending action sdidn't terminate")
(mred:test:reraise-error))]
[_ (mred:test:menu-select "File" new-name)]
[_ (wait-pending)]
[_ (wait (lambda () (not (eq? (mred:test:get-active-frame) console)))
"focus didn't change from the console after File|New")]
[frame (mred:test:get-active-frame)]
[_ (mred:test:keystroke #\a)]
[_ (mred:test:menu-select "File" "Close")]
[_ (wait (lambda () (not (eq? frame (mred:test:get-active-frame))))
"active frame remained original frame after File|Close")]
[_ (mred:test:button-push "Cancel")]
[_ (wait-pending)]
[_ (mred:test:menu-select "File" "Close")]
[_ (wait (lambda () (not (eq? frame (mred:test:get-active-frame))))
"active frame remained original frame after File|Close")]
[_ (mred:test:button-push "Cancel")]
[_ (wait-pending)]
[_ (wait (lambda () (eq? frame (mred:test:get-active-frame)))
"active frame did not return to editor frame")]
[_ (mred:test:menu-select "File" "Close")]
[_ (wait (lambda () (not (eq? frame (mred:test:get-active-frame))))
"active frame remained original frame after File|Close")]
[_ (mred:test:button-push "Close Anyway")]
[_ (wait-pending)]
[_ (unless (mred:get-preference 'mred:autosaving-on?)
(error 'autosave "autosaving preference turned off. Turn back on (with preferences dialog)"))]
[tmp-file (build-path dir "tmp.rktd")]
[backup-file (build-path dir "#tmp.rktd#1#")]
[_ (call-with-output-file tmp-file
(lambda (port) (display "12" port))
'truncate)]
[_ (when (file-exists? backup-file)
(delete-file backup-file))]
[_ (mred:edit-file tmp-file)]
[_ (wait (lambda () (not (eq? console (mred:test:get-active-frame))))
"after mred:edit-file, the console remained active")]
[frame (mred:test:get-active-frame)]
[_ (mred:test:keystroke #\3)]
[autosave-time (+ 10 (mred:get-preference 'mred:autosave-delay))]
[_ (printf "waiting for autosave timeout (~a secs)\n" autosave-time)]
[_ (sleep autosave-time)]
[_ (printf "finished waiting for autosave timeout\n")]
[_ (unless (file-exists? backup-file)
(error 'autosave "autosave file (~a) not created" backup-file))]
[_ (mred:test:menu-select "File" save-name)]
[_ (wait-pending)]
[_ (when (file-exists? backup-file)
(error 'autosave "autosave file (~a) not deleted after original file saved"))]
[_ (mred:test:menu-select "File" "Close")]
[_ (wait-pending)]
[_ (wait (lambda () (eq? (mred:test:get-active-frame) console))
"focus didn't return to the console after closing autosave test frame")])
(printf "test finished\n")))
;
; when rewriting, apply this function to:
; "New Unit"
; "Save Definitions"
; wx:frame%

View File

@ -1,5 +0,0 @@
(let ([f (load-relative "gui-main.rktl")])
(thread
(lambda ()
(f "New" "Save" mred:console-frame%))))

View File

@ -1,4 +1,7 @@
(require mzlib/list)
#lang racket/gui
(require racket/list)
(module test racket/base) ; no test
(define png-suite (build-path (or (current-load-relative-directory)
(current-directory))
@ -10,10 +13,10 @@
"The png-suite subdirectory appears to be missing. "
"It should contain the PNG test files (including GIFs for comparisons).")))
(define l (map (lambda (f) (build-path png-suite f))
(define l (map (lambda (f) (path->string (build-path png-suite f)))
(sort (filter (lambda (x) (regexp-match #rx"^[^x].*[.]png$" x))
(directory-list png-suite))
string<?)))
path<?)))
(define (png->gif f)
(regexp-replace #rx"[.]png$" f ".gif"))

View File

@ -1,5 +1,9 @@
#lang racket/load
(require racket/gui)
(load-relative "editor.rktl")
(load-relative "paramz.rktl")
(load-relative "dc.rktl")
(load-relative "cache-image-snip-test.rktl")
(load-relative "windowing.rktl")

View File

@ -1,145 +0,0 @@
(require mzlib/math)
(define measure-after? #f)
(define rotate? #f)
(define symbol? #f)
(define latin-1? #f)
(define less-aa? #f)
(define lucida? #f)
(define change-font? #f)
(define big-font? #f)
(define squash? #f)
(define one-by-one? #f)
(define shift+10+20? #f)
(define last-scale 1.5)
(define no-brush (make-object brush% "white" 'transparent))
(define xor-pen (make-object pen% "black" 0 'xor))
(define yellow (make-object color% "yellow"))
(define (get-the-font size)
(apply
make-object font%
size
(append
(if lucida?
'("-*-lucida")
'())
(list
(if symbol? 'symbol 'default)
'normal 'normal
#f (if less-aa? 'partly-smoothed 'default)))))
(define (draw-one dc str sx sy y w h d)
(define csx 1)
(define csy 1)
(send dc set-text-mode 'solid)
(send dc set-text-background yellow)
(if change-font?
(begin
(send dc set-font (get-the-font (inexact->exact (floor (* sy (if big-font? 14 12))))))
(set! csx sx)
(set! csy sy)
(set! sx 1)
(set! sy 1))
(send dc set-scale sx sy))
(if rotate?
(send dc draw-text str (/ 100 sx) (/ y sy) #f 0 (* pi -1/4))
(if one-by-one?
(let loop ([s (string->list str)]
[x (/ 100 sx)])
(unless (null? s)
(send dc draw-text (string (car s)) x (/ y sy))
(let-values ([(w h d a) (send dc get-text-extent (string (car s)))])
(loop (cdr s) (+ x w)))))
(send dc draw-text str (/ 100 sx) (/ y sy))))
(if measure-after?
(let-values ([(w h d a) (send dc get-text-extent str)])
(send dc draw-rectangle (/ 100 sx) (/ y sy) w h))
(send dc draw-rectangle (/ 100 sx) (/ y sy) (* w csx) (* h csy)))
(send dc set-scale 1 1))
(define (squash v)
(if squash? 1 v))
(define (draw-all dc)
(define normal-font (get-the-font (if big-font? 14 12)))
(define str (format "This is a t~ast"
(if latin-1? "\351" "e")))
(send dc set-font normal-font)
(send dc set-brush no-brush)
(send dc set-pen xor-pen)
(when shift+10+20?
(send dc set-origin 10 20))
(let-values ([(w h d a) (send dc get-text-extent str)])
(draw-one dc str 1 1 10 w h d)
(draw-one dc str 2 2 (+ 15 h) w h d)
(draw-one dc str 0.9 0.9 (+ 20 (* 3 h)) w h d)
(draw-one dc str 0.75 0.75 (+ 25 (* 4 h)) w h d)
(draw-one dc str 2 1 (+ 30 (* 5 h)) w h d)
(draw-one dc str 1 2 (+ 40 (* 6 h)) w h d)
(draw-one dc str 2.1 (squash 2.1) (+ 45 (* 8 h)) w h d)
(draw-one dc str 2.05 (squash 2.05) (+ 45 (* 10.2 h)) w h d)
(draw-one dc str 1.95 (squash 1.95) (+ 50 (* 12.2 h)) w h d)
(draw-one dc str 1.93 (squash 1.93) (+ 55 (* 14.2 h)) w h d)
(draw-one dc str 1.90 (squash 1.90) (+ 60 (* 16.2 h)) w h d)
(draw-one dc str last-scale (squash last-scale) (+ 65 (* 18.2 h)) w h d))
(when shift+10+20?
(send dc set-origin 0 0)))
(define f (new frame%
[label "Scale Test"]
[width 400]
[height 500]))
(define pane1 (new horizontal-pane%
[parent f]
[stretchable-height #f]))
(define pane2 (new horizontal-pane%
[parent f]
[stretchable-height #f]))
(define-syntax make-checkbox
(syntax-rules ()
[(_ who pane)
(new check-box%
[label (symbol->string 'who)]
[parent pane]
[callback (lambda (cb e)
(set! who (send cb get-value))
(send c refresh))])]))
(make-checkbox measure-after? pane1)
(make-checkbox change-font? pane1)
(make-checkbox rotate? pane1)
(make-checkbox one-by-one? pane1)
(make-checkbox symbol? pane2)
(make-checkbox latin-1? pane2)
(make-checkbox less-aa? pane2)
(make-checkbox lucida? pane2)
(make-checkbox big-font? pane2)
(make-checkbox squash? pane2)
(make-checkbox shift+10+20? pane2)
(new slider%
[label #f]
[parent f]
[style '(horizontal)]
[min-value 1]
[max-value 100]
[init-value 30]
[callback (lambda (s e)
(set! last-scale (/ (send s get-value) 20))
(send c refresh))])
(define c (new canvas%
[parent f]
[paint-callback
(lambda (c dc)
(send dc clear)
(draw-all dc))]))
(send f show #t)

View File

@ -1,443 +0,0 @@
;; GUI widget initialization tests
(require racket/gui)
(define frame
(new frame%
[label "label"]
[parent #f]
[width 100]
[height 100]
[x 0]
[y 0]
[style null]
[enabled #t]
[border 0]
[spacing 0]
[alignment '(center top)]
[min-width 100]
[min-height 100]
[stretchable-width #t]
[stretchable-height #t]))
(define cb (lambda (b e) (void)))
(define font (make-object font% 1 'system))
;; top levels
(make-object frame%
"label" ; label
#f ; parent
100 ; width
100 ; height
0 ; x
0 ; y
null ; style
#t ; enabled
0 ; border
0 ; spacing
'(center top) ; alignment
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object dialog%
"label" ; label
#f ; parent
100 ; width
100 ; height
0 ; x
0 ; y
null ; style
#t ; enabled
0 ; border
0 ; spacing
'(center top) ; alignment
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
;; panels
(make-object horizontal-panel%
frame ; parent
null ; style
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
0 ; border
0 ; spacing
'(center top) ; alignment
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object vertical-panel%
frame ; parent
null ; style
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
0 ; border
0 ; spacing
'(center top) ; alignment
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object tab-panel%
'("a" "b") ; choices
frame ; parent
cb ; callback
null ; style
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
0 ; border
0 ; spacing
'(center top) ; alignment
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object group-box-panel%
"label" ; label
frame ; parent
null ; style
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
0 ; border
0 ; spacing
'(center top) ; alignment
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
;; panes
(make-object horizontal-pane%
frame ; parent
0 ; vert-margin
0 ; horiz-margin
0 ; border
0 ; spacing
'(center top) ; alignment
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object vertical-pane%
frame ; parent
0 ; vert-margin
0 ; horiz-margin
0 ; border
0 ; spacing
'(center top) ; alignment
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
;; controls
(make-object message%
"label" ; label
frame ; parent
null ; style
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
#f ; auto-resize
)
(make-object button%
"label" ; label
frame ; parent
cb ; callback
null ; style
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object radio-box%
"label" ; label
'("a" "b") ; choices
frame ; parent
cb ; callback
'(vertical) ; style
0 ; selection
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object check-box%
"label" ; label
frame ; parent
cb ; callback
null ; style
#f ; value
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object slider%
"label" ; label
0 ; min-value
100 ; max-value
frame ; parent
cb ; callback
50 ; init-value
'(vertical) ; style
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object gauge%
"label" ; label
100 ; range
frame ; parent
'(vertical) ; style
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object text-field%
"label" ; label
frame ; parent
cb ; callback
"foo" ; init-value
'(single) ; style
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object combo-field%
"label" ; label
'("a" "b") ; choices
frame ; parent
cb ; callback
"foo" ; init-value
null ; style
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
;; list controls
(make-object choice%
"label" ; label
'("a" "b") ; choices
frame ; parent
cb ; callback
null ; style
0 ; selection
font ; font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object list-box%
"label" ; label
'("a" "b") ; choices
frame ; parent
cb ; callback
'(single) ; style
0 ; selection
font ; font
font ; label-font
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
'("Column") ; columns
#f ; column-order
)
;; canvases
(make-object canvas%
frame ; parent
null ; style
cb ; paint-callback
"label" ; label
#f ; gl-config
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
(make-object editor-canvas%
frame ; parent
#f ; editor
null ; style
100 ; scrolls-per-page
#f ; label
3 ; wheel-step
#f ; line-count
5 ; horizontal-inset
5 ; vertical-inset
#t ; enabled
0 ; vert-margin
0 ; horiz-margin
100 ; min-width
100 ; min-height
#t ; stretchable-width
#t ; stretchable-height
)
;; menus
(define menu
(make-object menu%
"label" ; label
(make-object menu-bar% frame) ; parent
#f ; help-string
(lambda (m) (void)) ; demand-callback
))
(make-object popup-menu%
"label" ; title
(lambda (p e) (void)) ; popdown-callback
(lambda (p) (void)) ; demand-callback
font ; font
)
(make-object menu-bar%
(new frame% [label ""]) ; parent
(lambda (p) (void)) ; demand-callback
)
(make-object menu-item%
"label" ; label
menu ; parent
cb ; callback
'up ; shortcut
"foo" ; help-string
(lambda (p) (void)) ; demand-callback
'(alt) ; shortcut-prefix
)
(make-object checkable-menu-item%
"label" ; label
menu ; parent
cb ; callback
'up ; shortcut
"foo" ; help-string
(lambda (p) (void)) ; demand-callback
#f ; checked
'(alt) ; shortcut-prefix
)
(make-object separator-menu-item%
menu ; parent
)
;; misc
(make-object key-event%
#\nul ; key-code
#f ; shift-down
#f ; control-down
#f ; meta-down
#f ; alt-down
0 ; x
0 ; y
0 ; time-stamp
#f ; caps-down
)
(make-object mouse-event%
'enter ; event-type
#f ; left-down
#f ; middle-down
#f ; right-down
0 ; x
0 ; y
#f ; shift-down
#f ; control-down
#f ; meta-down
#f ; alt-down
0 ; time-stamp
#f ; caps-down
)
(make-object mouse-event%
'top ; event-type
'vertical ; direction
0 ; position
0 ; time-stamp
)
(make-object mouse-event%
'button ; event-type
0 ; time-stamp
)

View File

@ -1,11 +1,9 @@
The files in this directory test the teaching language implementation.
htdp.rktl
load this file (racket -qr htdp.rktl) to run most of the tests
$ racket -qr htdp.rktl
test-htdp.rkt
this module runs most of the tests
htdp-image.rktl
load this file in gracket to run the htdp/image tests
$ gracket -qr htdp-image.rktl
test-image.rktl
this module runs the htdp/image tests
See beginner.rktl for more.

View File

@ -1,15 +0,0 @@
(let ([ol (current-load)])
(current-load
(λ x
(printf "cl ~s\n" x)
(apply ol x))))
(load-relative "../racket/loadtest.rktl")
(load-in-sandbox "beginner.rktl" #:testing "../racket/testing.rktl")
(load-in-sandbox "beginner-abbr.rktl" #:testing "../racket/testing.rktl")
(load-in-sandbox "intermediate.rktl" #:testing "../racket/testing.rktl")
(load-in-sandbox "intermediate-lambda.rktl" #:testing "../racket/testing.rktl")
(load-in-sandbox "advanced.rktl" #:testing "../racket/testing.rktl")
(report-errs)

View File

@ -0,0 +1,19 @@
#lang racket/load
(let ([ol (current-load)])
(current-load
(λ x
(printf "cl ~s\n" x)
(apply ol x))))
(load-relative (collection-file-path "loadtest.rktl" "tests/racket"))
(define testing-path (collection-file-path "testing.rktl" "tests/racket"))
(load-in-sandbox "beginner.rktl" #:testing testing-path)
(load-in-sandbox "beginner-abbr.rktl" #:testing testing-path)
(load-in-sandbox "intermediate.rktl" #:testing testing-path)
(load-in-sandbox "intermediate-lambda.rktl" #:testing testing-path)
(load-in-sandbox "advanced.rktl" #:testing testing-path)
(report-errs)

View File

@ -1,7 +1,9 @@
;; Load this one with GRacket
#lang racket/load
(load-relative (collection-file-path "loadtest.rktl" "tests/racket"))
(require racket/gui/base
(require racket/draw
racket/snip
teachpack/htdp/image
htdp/error
lang/posn

View File

@ -653,14 +653,27 @@ path/s is either such a string or a list of them.
"pkgs/compatibility-pkgs/compatibility-lib/mzlib/traceld.rkt" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/awk.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/binc.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/contract-mzlib-test.rktl" responsible (robby) drdr:command-line (racket "-r" *)
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/cmdline.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/compat.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/contract-mzlib-test.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/etc.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/kw.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/loadtest.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/macrolib.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/pconvert.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/serialize.rktl" drdr:random #t
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/structlib.rktl" drdr:random #t
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/restart.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/serialize.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/string-mzlib.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/structlib.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/testing.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/tests.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/threadlib.rktl" drdr:random #t
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/threadlib.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/ttt/uinc4.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/uinc.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/uinc2.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/uinc3.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/unit.rktl" drdr:command-line #f
"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/unitsig.rktl" drdr:command-line #f
"pkgs/compiler-pkgs" responsible (mflatt jay)
"pkgs/compiler-pkgs/compiler-lib/compiler/commands/exe-dir.rkt" drdr:command-line #f
"pkgs/compiler-pkgs/compiler-lib/compiler/commands/exe.rkt" drdr:command-line #f
@ -859,19 +872,21 @@ path/s is either such a string or a list of them.
"pkgs/gui-pkgs/gui-test/framework/tests/search.rkt" drdr:command-line (mzc "-k" *)
"pkgs/gui-pkgs/gui-test/framework/tests/test-suite-utils.rkt" drdr:command-line (mzc "-k" *)
"pkgs/gui-pkgs/gui-test/framework/tests/text.rkt" drdr:command-line (mzc "-k" *)
"pkgs/gui-pkgs/gui-test/tests/gracket/auto.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/blits.rkt" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/cache-image-snip-test.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/draw-mem.rkt" drdr:random #t
"pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt" drdr:command-line (mzc *)
"pkgs/gui-pkgs/gui-test/tests/gracket/editor.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/flush-stress.rkt" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/item.rkt" drdr:command-line (mzc *)
"pkgs/gui-pkgs/gui-test/tests/gracket/loadtest.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/mem.rkt" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/paramz.rktl" drdr:command-line (gracket "-f" *) drdr:random #t
"pkgs/gui-pkgs/gui-test/tests/gracket/png.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/paramz.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/showkey.rkt" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/text-scale.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/testing.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/unflushed-circle.rkt" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/windowing.rktl" drdr:command-line (gracket "-f" *) drdr:random #t
"pkgs/gui-pkgs/gui-test/tests/gracket/windowing.rktl" drdr:command-line #f
"pkgs/gui-pkgs/gui-test/tests/gracket/wxme-doc-random.rkt" drdr:command-line (mzc *)
"pkgs/gui-pkgs/gui-test/tests/gracket/wxme-random.rkt" drdr:command-line #f
"pkgs/honu" responsible (mflatt rafkind)
@ -930,20 +945,22 @@ path/s is either such a string or a list of them.
"pkgs/htdp-pkgs/htdp-test/htdp/tests/matrix-example.rkt" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/htdp/tests/world-mouse.rkt" drdr:command-line (mzc *)
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang" responsible (robby mflatt matthias)
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/advanced.rktl" drdr:timeout 360
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/advanced.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/beg-adv.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/beg-bega.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/beg-intm.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/beg-intml.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/bega-adv.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/beginner-abbr.rktl" drdr:timeout 300
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/htdp-image.rktl" responsible (robby)
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/htdp.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/intermediate-lambda.rktl" drdr:timeout 360
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/intermediate.rktl" drdr:timeout 360
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/beginner-abbr.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/beginner.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/htdp-test.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/intermediate-lambda.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/intermediate.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/intm-adv.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/intm-intml.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/intmlam-adv.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/test-htdp.rkt" drdr:timeout 360
"pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/test-image.rkt" responsible (robby)
"pkgs/htdp-pkgs/htdp-test/tests/stepper" responsible (clements)
"pkgs/htdp-pkgs/htdp-test/tests/stepper/already-defined.rktl" drdr:command-line #f
"pkgs/htdp-pkgs/htdp-test/tests/stepper/automatic-tests.rkt" drdr:timeout 600
@ -1069,6 +1086,7 @@ path/s is either such a string or a list of them.
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/mk-bigloo.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/mk-chicken.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/mk-gambit.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/r5rs-wrap.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/typed" responsible (stamourv samth)
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/typed/collatz-q.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/typed/collatz.rktl" drdr:command-line #f
@ -1095,8 +1113,7 @@ path/s is either such a string or a list of them.
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/typed/takr.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/typed/takr2.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/common/typed/triangle.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/mz/redsem.rktl" drdr:command-line (racket "-f" * "--" "--skip-struct-test")
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/mz/ssax.rktl" drdr:timeout 900
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/mz/ssax.rkt" drdr:timeout 900
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/places" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/rx/auto.rkt" drdr:command-line (racket * "racket" "simple") drdr:timeout 600 drdr:random #t
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/shootout/ackermann.rkt" drdr:command-line (racket * "10")
@ -1197,6 +1214,7 @@ path/s is either such a string or a list of them.
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/shootout/typed/nestedloop-non-optimizing.rkt" drdr:command-line (racket * "2")
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/shootout/typed/nestedloop-optimizing.rkt" drdr:command-line (racket * "2")
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/shootout/typed/nestedloop.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/shootout/typed/nothing.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/shootout/typed/nsieve-non-optimizing.rkt" drdr:command-line (racket * "2")
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/shootout/typed/nsieve-optimizing.rkt" drdr:command-line (racket * "2")
"pkgs/racket-pkgs/racket-benchmarks/tests/racket/benchmarks/shootout/typed/nsieve.rktl" drdr:command-line #f
@ -1292,9 +1310,16 @@ path/s is either such a string or a list of them.
"pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt" drdr:command-line (raco "test" *) drdr:timeout 2400
"pkgs/racket-pkgs/racket-test/tests/racket" responsible (mflatt)
"pkgs/racket-pkgs/racket-test/tests/racket/all.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/async-channel.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/basic.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/boundmap-test.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/bytes.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/censor.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/char-set.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/cm.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/cmdline.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/collects.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/contmark.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/contract" responsible (robby)
"pkgs/racket-pkgs/racket-test/tests/racket/contract/all.rkt" drdr:command-line (raco "make" *)
@ -1302,27 +1327,52 @@ path/s is either such a string or a list of them.
"pkgs/racket-pkgs/racket-test/tests/racket/contract-rand-test.rkt" responsible (robby) drdr:command-line (racket *)
"pkgs/racket-pkgs/racket-test/tests/racket/contract-stress-argmin.rkt" responsible (robby) drdr:command-line (racket "-r" *)
"pkgs/racket-pkgs/racket-test/tests/racket/contract-stress-take-right.rkt" responsible (robby) drdr:command-line (racket "-r" *)
"pkgs/racket-pkgs/racket-test/tests/racket/control.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/core-tests.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/cstruct.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/date.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/deep.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/dict.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/embed-in-c.rkt" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/expand.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/extflonum.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/file.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/filelib.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/fixnum.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/flonum.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/for.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/format.rkt" drdr:random #t
"pkgs/racket-pkgs/racket-test/tests/racket/function.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/generator.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/id-table-test.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/iostream.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/link.rkt" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/list.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/loadable.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/loadtest.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/logger.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/macro.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/math.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/moddep.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/modprot.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/module-reader.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/module.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/mpair.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/name.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/namespac.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/number.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/numstrs.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/object.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/pack.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/package.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/parallel-build.rkt" drdr:random #t
"pkgs/racket-pkgs/racket-test/tests/racket/parallel-plot.rkt" drdr:timeout 400
"pkgs/racket-pkgs/racket-test/tests/racket/parallel.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/param.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/path.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/pathlib.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/place-chan-rand-help.rkt" responsible (tewk)
"pkgs/racket-pkgs/racket-test/tests/racket/place-chan-rand.rkt" responsible (tewk)
"pkgs/racket-pkgs/racket-test/tests/racket/place-channel-fd.rkt" responsible (tewk) drdr:random #t
@ -1331,45 +1381,58 @@ path/s is either such a string or a list of them.
"pkgs/racket-pkgs/racket-test/tests/racket/place-channel-socket.rkt" responsible (tewk) drdr:random #t
"pkgs/racket-pkgs/racket-test/tests/racket/place-channel.rkt" responsible (tewk) drdr:timeout 300 drdr:random #t
"pkgs/racket-pkgs/racket-test/tests/racket/place-parallel.rkt" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/place.rktl" responsible (tewk)
"pkgs/racket-pkgs/racket-test/tests/racket/place.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/places.rkt" responsible (tewk)
"pkgs/racket-pkgs/racket-test/tests/racket/port.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/portlib.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/pretty.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/print.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/procs.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/prompt-sfs.rkt" drdr:random #t
"pkgs/racket-pkgs/racket-test/tests/racket/prompt-tests.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/quiet.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/read.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/readtable.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/resource.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/runaway-place.rkt" drdr:random #t
"pkgs/racket-pkgs/racket-test/tests/racket/rx.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/sandbox.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/scheme-tests.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/sequence.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/serialize.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/set.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/setup.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/shared-tests.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/srcloc.rktl" responsible (cce)
"pkgs/racket-pkgs/racket-test/tests/racket/shared.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/srcloc.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/stream.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/stress" responsible (jay) drdr:random #t
"pkgs/racket-pkgs/racket-test/tests/racket/stress/contract-lifting.rkt" responsible (robby sstrickl)
"pkgs/racket-pkgs/racket-test/tests/racket/stress/dict.rkt" drdr:timeout 180
"pkgs/racket-pkgs/racket-test/tests/racket/stress/fuzz.rkt" responsible (samth mflatt) drdr:command-line (racket * "-c") drdr:timeout 600
"pkgs/racket-pkgs/racket-test/tests/racket/stress/module-stack.rkt" drdr:timeout 500
"pkgs/racket-pkgs/racket-test/tests/racket/string.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/struct.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/stx.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/stxparam.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/submodule.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/subprocess.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/sync.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/syntaxlibs.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/test.rkt" drdr:timeout 600
"pkgs/racket-pkgs/racket-test/tests/racket/testing.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/thread.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/thrport.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/trace.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/trait.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/udp.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/uni-norm.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/unicode.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/unsafe.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/vector.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/version.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/racket/will.rktl" drdr:command-line #f
"pkgs/racket-pkgs/racket-test/tests/run-automated-tests.rkt" responsible (eli) drdr:command-line (mzc "-k" *) drdr:timeout 600
"pkgs/racket-pkgs/racket-test/tests/stress.rkt" responsible (jay)
@ -1596,5 +1659,6 @@ path/s is either such a string or a list of them.
"racket/collects/syntax/parse.rkt" responsible (ryanc)
"racket/collects/unstable/sequence.rkt" responsible (samth)
"racket/src/foreign" responsible (eli)
"racket/src/racket/src/startup.rktl" drdr:command-line #f
#:end-props |#

View File

@ -0,0 +1,11 @@
#lang racket/base
(parameterize ([current-namespace (make-base-namespace)])
(let ([path (collection-file-path "class-internal.rkt" "racket/private")])
(define-values (dir name dir?) (split-path path))
(with-input-from-file path
(lambda ()
(parameterize ([current-load-relative-directory dir]
[read-accept-reader #t])
(let ([s (read-syntax)])
(void (time (compile s)))))))))

View File

@ -1,9 +0,0 @@
(let ([path (collection-file-path "class-internal.rkt" "racket/private")])
(define-values (dir name dir?) (split-path path))
(with-input-from-file path
(lambda ()
(parameterize ([current-load-relative-directory dir]
[read-accept-reader #t])
(let ([s (read-syntax)])
(time (compile s)))))))

View File

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

View File

@ -1,4 +1,7 @@
(require syntax-color/scheme-lexer scheme/gui/base)
#lang racket/base
(require syntax-color/scheme-lexer
racket/class
racket/gui/base)
(define path (build-path (collection-path "framework" "private") "frame.rkt"))
@ -35,7 +38,8 @@
(port-count-lines! p)
(time
(let loop ()
(let ([v (read p)])
(let ([v (parameterize ([read-accept-reader #t])
(read p))])
(unless (eof-object? v)
(loop)))))))
(printf "done\n")

View File

@ -1,3 +1,5 @@
#lang racket/load
#|
Time the cache-less version of the pattern matcher

View File

@ -0,0 +1,10 @@
#lang racket/base
(require (planet "ssax.ss" ("lizorkin" "ssax.plt" 2))
racket/runtime-path)
(define-runtime-path input-file "input.xml")
(collect-garbage)
(time (void (ssax:xml->sxml
(open-input-file input-file)
null)))

View File

@ -1,8 +0,0 @@
(require (planet "ssax.ss" ("lizorkin" "ssax.plt" 2)))
(collect-garbage)
(time (void (ssax:xml->sxml
(open-input-file (build-path
(current-load-relative-directory)
"input.xml"))
null)))

View File

@ -12,6 +12,7 @@
(load-in-sandbox "dict.rktl")
(load-in-sandbox "fixnum.rktl")
(load-in-sandbox "flonum.rktl")
(load-in-sandbox "string.rktl")
(load-in-sandbox "mpair.rktl")
(load-in-sandbox "async-channel.rktl")

View File

@ -20,6 +20,7 @@
(load-relative "thread.rktl")
(load-relative "logger.rktl")
(load-relative "sync.rktl")
(load-relative "place.rktl")
(load-relative "deep.rktl")
(load-relative "contmark.rktl")
(load-relative "prompt.rktl")

View File

@ -1,27 +0,0 @@
(define five +)
(define (one v)
(if (equal? v 15)
(apply five (list 1 2 3 4 5))
15))
(define (dloop x d)
(if (zero? d)
0
(if (equal? x 15)
(let ([v (one 10)])
(let ([c (one v)])
(add1 (dloop c (sub1 d)))))
(dloop 15 d))))
(define (loop)
(let loop ([n 0])
(let ([v (dloop 0 n)])
(if (equal? n v)
(begin
(when (zero? (modulo n 100))
(printf "~a\n" n))
(loop (add1 n)))
(error 'loop "messed up: ~a != ~a\n" n v)))))

View File

@ -3,7 +3,7 @@
(Section 'string)
(require scheme/string)
(require racket/string)
;; ---------- real->decimal-string ----------
(test "0." real->decimal-string 0 0)

View File

@ -1,59 +0,0 @@
(define id 40000)
(define max-send 100000)
(define print-mod 10000)
(define (client host)
(lambda ()
(let-values ([(r w) (tcp-connect host id)])
(values r w void))))
(define server
(lambda ()
(let ([l (tcp-listen id)])
(let-values ([(r w) (tcp-accept l)])
(values r w (lambda () (tcp-close l)))))))
(define (tread connect)
(let-values ([(r w close) (connect)])
(printf "Hit return to start reading\n")
(read-line)
(let loop ([last -1])
(let ([v (read r)])
(if (eof-object? v)
(begin
(close-input-port r)
(close-output-port w)
(close)
last)
(begin
(unless (= v (add1 last))
(printf "skipped! ~a ~a\n" last v))
(when (zero? (modulo v print-mod))
(printf "got ~a\n" v))
(loop v)))))))
(define (twrite connect)
(let-values ([(r w close) (connect)]
[(t) (thread (lambda ()
(let loop ()
(sleep 1)
(printf "tick\n")
(loop))))])
(let ([done (lambda ()
(close-output-port w)
(close-input-port r)
(close)
(kill-thread t))])
(let loop ([n 0])
(if (= n max-send)
(begin
(printf "stopped before ~a\n" n)
(done))
(begin
(fprintf w "~s\n" n)
(when (zero? (modulo n print-mod))
(printf "sent ~a\n" n))
(loop (add1 n))))))))

View File

@ -1,3 +1,5 @@
#lang racket/load
(module test1 mzscheme
(require mzlib/unit)
(provide s1)

View File

@ -1,3 +1,5 @@
#lang racket/load
(module test mzscheme
(require mzlib/unit)

View File

@ -1,6 +1,7 @@
#lang racket/load
(require (for-syntax mzlib/unit-exptime))
(require "test-harness.rkt"
;unit
mzlib/unit)
(define-signature one^ (one-a one-b))
@ -41,3 +42,4 @@
(test '(((#f . one^) (#f . three^)) ((#f . two^))) (unit-info one@ quote))
(test '(((Four . four^)) ((One . one^))) (unit-info two@ quote))
(displayln "tests passed")

View File

@ -28,7 +28,7 @@
(syntax-rules ()
((_ err expr)
(with-handlers ((exn:fail:syntax? (lambda (exn)
(printf "syntax error \"~a\"\n got message \"~a\"\n\n"
(printf "get expected syntax error \"~a\"\n got message \"~a\"\n\n"
err
(exn-message exn)))))
(expand #'expr)
@ -38,7 +38,7 @@
(syntax-rules ()
((_ err-pred err expr)
(with-handlers ((err-pred (lambda (exn)
(printf "runtime error \"~a\"\n got message \"~a\"\n\n"
(printf "got expected runtime error \"~a\"\n got message \"~a\"\n\n"
err
(exn-message exn)))))
expr

View File

@ -1,3 +1,5 @@
#lang racket/load
(require "test-harness.rkt"
racket/private/unit-runtime)
@ -49,3 +51,5 @@
;; check-deps
;;UNTESTED
(displayln "tests passed")

View File

@ -1,3 +1,5 @@
#lang racket/load
(require "test-harness.rkt"
scheme/unit
scheme/contract)
@ -45,7 +47,7 @@
"object \"~a\" not found in:\n\"~a\""
obj msg)]
[else
(printf "contract error \"~a\" on ~a blaming ~a: ok\n\t\"~a\"\n\n"
(printf "got expected contract error \"~a\" on ~a blaming ~a: ok\n\t\"~a\"\n\n"
err obj blame (get-ctc-err msg))])))))
expr
(error 'test-contract-error
@ -890,3 +892,5 @@
[((S : s^)) s@ T])))
(define-values/invoke-unit c@ (import) (export s^))
(new-make-t))
(displayln "tests passed")

View File

@ -1,3 +1,5 @@
#lang racket/load
(require (for-syntax racket/private/unit-compiletime
racket/private/unit-syntax))
(require "test-harness.rkt"
@ -1785,4 +1787,4 @@
(define-values/invoke-unit u@ (import) (export s^))
x))
(displayln "tests passed")

View File

@ -1,3 +1,5 @@
#lang racket/base
(require rackunit)
(require rackunit/text-ui)
(require "all-1-tests.rkt")

View File

@ -1,3 +1,5 @@
#lang racket/base
(require rackunit)
(require rackunit/text-ui)
(require "all-srfi-40-tests.rkt")

View File

@ -1,3 +1,5 @@
#lang racket/base
(require rackunit)
(require rackunit/text-ui)
(require "all-srfi-43-tests.rkt")

View File

@ -1,8 +1,9 @@
#lang racket/load
;;; This file simply tests that all the SRFIs load. Just
;;; load it into Racket to perform this test. Remember it
;;; might not be up-to-date, so check before you run it!
(require srfi/1)
(require srfi/2)
(require srfi/4)
@ -84,3 +85,5 @@
(require srfi/78/check)
(require srfi/86/86)
(require srfi/87/case)
(displayln "all loaded")

View File

@ -1,3 +1,5 @@
#lang racket/load
(load-relative (collection-file-path "loadtest.rktl" "tests/racket"))
(require mzlib/class
syntax-color/paren-tree)

View File

@ -1,5 +1,7 @@
#lang racket/load
(load-relative (collection-file-path "loadtest.rktl" "tests/racket"))
(require mzlib/class
(require racket/class
syntax-color/token-tree)
(define t (new token-tree% (length 1) (data 'a)))