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

clean up drracket tests

Browse Source
This commit is contained in:
Robby Findler 2013-08-09 17:42:27 -05:00
parent 517b8fe11f
commit 512009f7fa
4 changed files with 37 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -57,13 +57,13 @@ the settings above should match r5rs
(lambda () (fw:test:set-check-box! "Enforce constant definitions (enables some inlining)" #f))
"enforce-module-constants -- #f"
"#lang racket/base\n(define x 1)\n"
#:interactions "(set! x 2)\n"
#:interactions "(set! x 2)"
"> (set! x 2)")
(test-setting
(lambda () (fw:test:set-check-box! "Enforce constant definitions (enables some inlining)" #t))
"enforce-module-constants -- #t"
"#lang racket/base\n(define x 1)\n"
#:interactions "(set! x 2)\n"
#:interactions "(set! x 2)"
#rx"cannot modify a constant")
(prepare-for-test-expression)
@ -1126,8 +1126,9 @@ the settings above should match r5rs
(clear-definitions drs)
(insert-in-definitions drs expression)
(do-execute drs)
(when interactions
(when interactions-expr
(insert-in-interactions drs interactions-expr)
(alt-return-in-interactions drs)
(wait-for-computation drs))
(let* ([got (fetch-output/should-be-tested drs)])
(unless (if (regexp? result)
@ -1358,7 +1359,7 @@ the settings above should match r5rs
[(eq? item 'image)
(use-get/put-dialog
(lambda () (fw:test:menu-select "Insert" "Insert Image..."))
(simplify-path (build-path (collection-path "icons") "recycle.png")))]
(simplify-path (build-path (collection-file-path "recycle.png" "icons"))))]
[(string? item)
(insert-in-definitions drs item)]
[(eq? item 'xml)

6
pkgs/drracket-pkgs/drracket-test/tests/drracket/private/repl-test.rkt
View File

@ -973,11 +973,7 @@ This produces an ACK message
(define backtrace-image-string "{stop-multi.png}")
(define file-image-string "{stop-22x22.png}")
(define tmp-load-directory (find-system-path 'temp-dir)
#;
(normal-case-path
(normalize-path
(collection-path "tests" "drracket"))))
(define tmp-load-directory (find-system-path 'temp-dir))
(define tmp-load-short-filename "repl-test-tmp.rkt")
(define tmp-load-filename (build-path tmp-load-directory tmp-load-short-filename))

14
pkgs/drracket-pkgs/drracket-test/tests/drracket/sample-solutions-one-window.rkt
View File

@ -29,7 +29,9 @@
(define ((test-single-file labels sample-solutions-dir toc) filename)
(let* ([sample-solutions-teachpack-filename
(build-path (collection-path "tests" "drracket") "sample-solutions-testsuite-tp.scm")]
(build-path (collection-file-path "sample-solutions-testsuite-tp.scm"
"tests"
"drracket"))]
[toc-entry (let ([lookup (assoc (string->symbol filename) toc)])
(if lookup
(cdr lookup)
@ -82,7 +84,8 @@
(send interactions-text get-text
(send interactions-text paragraph-start-position 2)
(send interactions-text paragraph-start-position
(+ 2 (length teachpacks) 1)))))] ;; add 1 for the always there teachpack
;; add 1 for the always there teachpack
(+ 2 (length teachpacks) 1)))))]
[teachpacks-already-set? (string=? teachpack-should-be teachpack-is)])
(unless teachpacks-already-set?
(fw:test:menu-select "Language" "Clear All Teachpacks")
@ -126,7 +129,8 @@
(has-error? drs-frame))
=>
(lambda (err-msg)
(printf "ERROR: ~a: found error, but should be no errors (section ~a):\n ~a\n teachpacks: ~a\n"
(printf (string-append "ERROR: ~a: found error, but should be no errors"
" (section ~a):\n ~a\n teachpacks: ~a\n")
filename
section
err-msg
@ -148,7 +152,9 @@
(lambda (exn) exn)])
(read port))])
(unless (equal? after last)
(printf "ERROR: ~a: pair #~a mismatched.\n got ~s\nexpected ~s\nteachpacks: ~a\n"
(printf (string-append
"ERROR: ~a: pair #~a mismatched."
"\n got ~s\nexpected ~s\nteachpacks: ~a\n")
filename equal-count
(if (exn? last) (exn-message last) last)
(if (exn? after) (exn-message after) after)

41
pkgs/drracket-pkgs/drracket-test/tests/drracket/teachpack.rkt
View File

@ -20,26 +20,27 @@
(fw:test:menu-select "Language" "Clear All Teachpacks")
(let ([tp-names
(let ([teachpack-path (normal-case-path
(normalize-path
(collection-path "tests" "drracket")))])
(let loop ([tp-exps tp-exps]
[n 0])
(cond
[(null? tp-exps) null]
[else
(let ([tp-name (build-path teachpack-path
(string-append
(format good-teachpack-name n)
".ss"))])
(call-with-output-file tp-name
(lambda (port) (write (car tp-exps) port))
'truncate)
(use-get/put-dialog
(lambda ()
(fw:test:menu-select "Language" "Add Teachpack..."))
tp-name)
(cons tp-name (loop (cdr tp-exps) (+ n 1))))])))])
(let loop ([tp-exps tp-exps]
[n 0])
(cond
[(null? tp-exps) null]
[else
(let ([tp-name
(normal-case-path
(normalize-path
(collection-file-path
(string-append
(format good-teachpack-name n)
".ss")
"tests" "drracket")))])
(call-with-output-file tp-name
(lambda (port) (write (car tp-exps) port))
'truncate)
(use-get/put-dialog
(lambda ()
(fw:test:menu-select "Language" "Add Teachpack..."))
tp-name)
(cons tp-name (loop (cdr tp-exps) (+ n 1))))]))])
(do-execute drs-frame)