convert ".rktl" test entry points to ".rkt"
This commit is contained in:
parent
0edcbf3f82
commit
f6b8f734f3
|
@ -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)))))))))
|
|
@ -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%
|
|
@ -1,5 +0,0 @@
|
|||
(let ([f (load-relative "gui-main.rktl")])
|
||||
(thread
|
||||
(lambda ()
|
||||
(f "New" "Save" mred:console-frame%))))
|
||||
|
|
@ -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"))
|
|
@ -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")
|
|
@ -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)
|
|
@ -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
|
||||
)
|
|
@ -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.
|
||||
|
|
|
@ -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)
|
19
pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/test-htdp.rkt
Normal file
19
pkgs/htdp-pkgs/htdp-test/tests/htdp-lang/test-htdp.rkt
Normal 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)
|
|
@ -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
|
|
@ -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 |#
|
||||
|
|
|
@ -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)))))))))
|
|
@ -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)))))))
|
|
@ -0,0 +1,3 @@
|
|||
#lang info
|
||||
|
||||
(define compile-omit-paths 'all)
|
|
@ -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")
|
|
@ -1,3 +1,5 @@
|
|||
#lang racket/load
|
||||
|
||||
#|
|
||||
|
||||
Time the cache-less version of the pattern matcher
|
|
@ -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)))
|
|
@ -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)))
|
|
@ -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")
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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)))))
|
|
@ -3,7 +3,7 @@
|
|||
|
||||
(Section 'string)
|
||||
|
||||
(require scheme/string)
|
||||
(require racket/string)
|
||||
|
||||
;; ---------- real->decimal-string ----------
|
||||
(test "0." real->decimal-string 0 0)
|
||||
|
|
|
@ -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))))))))
|
|
@ -1,3 +1,5 @@
|
|||
#lang racket/load
|
||||
|
||||
(module test1 mzscheme
|
||||
(require mzlib/unit)
|
||||
(provide s1)
|
|
@ -1,3 +1,5 @@
|
|||
#lang racket/load
|
||||
|
||||
(module test mzscheme
|
||||
(require mzlib/unit)
|
||||
|
|
@ -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")
|
|
@ -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
|
||||
|
|
|
@ -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")
|
|
@ -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")
|
|
@ -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")
|
|
@ -1,3 +1,5 @@
|
|||
#lang racket/base
|
||||
|
||||
(require rackunit)
|
||||
(require rackunit/text-ui)
|
||||
(require "all-1-tests.rkt")
|
|
@ -1,3 +1,5 @@
|
|||
#lang racket/base
|
||||
|
||||
(require rackunit)
|
||||
(require rackunit/text-ui)
|
||||
(require "all-srfi-40-tests.rkt")
|
|
@ -1,3 +1,5 @@
|
|||
#lang racket/base
|
||||
|
||||
(require rackunit)
|
||||
(require rackunit/text-ui)
|
||||
(require "all-srfi-43-tests.rkt")
|
|
@ -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")
|
|
@ -1,3 +1,5 @@
|
|||
#lang racket/load
|
||||
|
||||
(load-relative (collection-file-path "loadtest.rktl" "tests/racket"))
|
||||
(require mzlib/class
|
||||
syntax-color/paren-tree)
|
|
@ -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)))
|
Loading…
Reference in New Issue
Block a user