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)) (lambda () (fw:test:set-check-box! "Enforce constant definitions (enables some inlining)" #f))
"enforce-module-constants -- #f" "enforce-module-constants -- #f"
"#lang racket/base\n(define x 1)\n" "#lang racket/base\n(define x 1)\n"
#:interactions "(set! x 2)\n" #:interactions "(set! x 2)"
"> (set! x 2)") "> (set! x 2)")
(test-setting (test-setting
(lambda () (fw:test:set-check-box! "Enforce constant definitions (enables some inlining)" #t)) (lambda () (fw:test:set-check-box! "Enforce constant definitions (enables some inlining)" #t))
"enforce-module-constants -- #t" "enforce-module-constants -- #t"
"#lang racket/base\n(define x 1)\n" "#lang racket/base\n(define x 1)\n"
#:interactions "(set! x 2)\n" #:interactions "(set! x 2)"
#rx"cannot modify a constant") #rx"cannot modify a constant")
(prepare-for-test-expression) (prepare-for-test-expression)
@ -1126,8 +1126,9 @@ the settings above should match r5rs
(clear-definitions drs) (clear-definitions drs)
(insert-in-definitions drs expression) (insert-in-definitions drs expression)
(do-execute drs) (do-execute drs)
(when interactions (when interactions-expr
(insert-in-interactions drs interactions-expr) (insert-in-interactions drs interactions-expr)
(alt-return-in-interactions drs)
(wait-for-computation drs)) (wait-for-computation drs))
(let* ([got (fetch-output/should-be-tested drs)]) (let* ([got (fetch-output/should-be-tested drs)])
(unless (if (regexp? result) (unless (if (regexp? result)
@ -1358,7 +1359,7 @@ the settings above should match r5rs
[(eq? item 'image) [(eq? item 'image)
(use-get/put-dialog (use-get/put-dialog
(lambda () (fw:test:menu-select "Insert" "Insert Image...")) (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) [(string? item)
(insert-in-definitions drs item)] (insert-in-definitions drs item)]
[(eq? item 'xml) [(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 backtrace-image-string "{stop-multi.png}")
(define file-image-string "{stop-22x22.png}") (define file-image-string "{stop-22x22.png}")
(define tmp-load-directory (find-system-path 'temp-dir) (define tmp-load-directory (find-system-path 'temp-dir))
#;
(normal-case-path
(normalize-path
(collection-path "tests" "drracket"))))
(define tmp-load-short-filename "repl-test-tmp.rkt") (define tmp-load-short-filename "repl-test-tmp.rkt")
(define tmp-load-filename (build-path tmp-load-directory tmp-load-short-filename)) (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) (define ((test-single-file labels sample-solutions-dir toc) filename)
(let* ([sample-solutions-teachpack-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)]) [toc-entry (let ([lookup (assoc (string->symbol filename) toc)])
(if lookup (if lookup
(cdr lookup) (cdr lookup)
@ -82,7 +84,8 @@
(send interactions-text get-text (send interactions-text get-text
(send interactions-text paragraph-start-position 2) (send interactions-text paragraph-start-position 2)
(send interactions-text paragraph-start-position (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)]) [teachpacks-already-set? (string=? teachpack-should-be teachpack-is)])
(unless teachpacks-already-set? (unless teachpacks-already-set?
(fw:test:menu-select "Language" "Clear All Teachpacks") (fw:test:menu-select "Language" "Clear All Teachpacks")
@ -126,7 +129,8 @@
(has-error? drs-frame)) (has-error? drs-frame))
=> =>
(lambda (err-msg) (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 filename
section section
err-msg err-msg
@ -148,7 +152,9 @@
(lambda (exn) exn)]) (lambda (exn) exn)])
(read port))]) (read port))])
(unless (equal? after last) (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 filename equal-count
(if (exn? last) (exn-message last) last) (if (exn? last) (exn-message last) last)
(if (exn? after) (exn-message after) after) (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") (fw:test:menu-select "Language" "Clear All Teachpacks")
(let ([tp-names (let ([tp-names
(let ([teachpack-path (normal-case-path (let loop ([tp-exps tp-exps]
(normalize-path [n 0])
(collection-path "tests" "drracket")))]) (cond
(let loop ([tp-exps tp-exps] [(null? tp-exps) null]
[n 0]) [else
(cond (let ([tp-name
[(null? tp-exps) null] (normal-case-path
[else (normalize-path
(let ([tp-name (build-path teachpack-path (collection-file-path
(string-append (string-append
(format good-teachpack-name n) (format good-teachpack-name n)
".ss"))]) ".ss")
(call-with-output-file tp-name "tests" "drracket")))])
(lambda (port) (write (car tp-exps) port)) (call-with-output-file tp-name
'truncate) (lambda (port) (write (car tp-exps) port))
(use-get/put-dialog 'truncate)
(lambda () (use-get/put-dialog
(fw:test:menu-select "Language" "Add Teachpack...")) (lambda ()
tp-name) (fw:test:menu-select "Language" "Add Teachpack..."))
(cons tp-name (loop (cdr tp-exps) (+ n 1))))])))]) tp-name)
(cons tp-name (loop (cdr tp-exps) (+ n 1))))]))])
(do-execute drs-frame) (do-execute drs-frame)