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

fix teachpack test

Browse Source 
Also, Rackety
This commit is contained in:
Robby Findler 2013-09-04 16:25:28 -05:00
parent 09574ed920
commit 1894e2777c
1 changed files with 29 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -189,40 +189,35 @@
(define (test-built-in-teachpacks) (define (test-built-in-teachpacks)
(clear-definitions drs-frame) (clear-definitions drs-frame)
(type-in-definitions drs-frame "1") (type-in-definitions drs-frame "1")
(let* ([test-teachpack (define (test-teachpack dir teachpack)
(lambda (dir) (when (or (equal? #"ss" (filename-extension teachpack))
(lambda (teachpack) (equal? #"scm" (filename-extension teachpack))
(when (or (equal? #"ss" (filename-extension teachpack)) (equal? #"rkt" (filename-extension teachpack)))
(equal? #"scm" (filename-extension teachpack)) (unless (or (equal? "graphing.ss" (path->string teachpack))
(equal? #"rkt" (filename-extension teachpack))) (regexp-match #rx"^info[.].*$" (path->string teachpack)))
(unless (equal? "graphing.ss" (path->string teachpack)) (printf " testing ~a\n" teachpack)
(printf " testing ~a\n" teachpack) (fw:test:menu-select "Language" "Clear All Teachpacks")
(fw:test:menu-select "Language" "Clear All Teachpacks") (fw:test:menu-select "Language" "Add Teachpack...")
(fw:test:menu-select "Language" "Add Teachpack...") (wait-for-new-frame drs-frame)
(wait-for-new-frame drs-frame) (define tp-dialog (test:get-active-top-level-window))
(let* ([tp-dialog (test:get-active-top-level-window)] (define choice (find/select-relevant-choice tp-dialog (path->string teachpack)))
[choice (find/select-relevant-choice tp-dialog (path->string teachpack))]) (fw:test:button-push "OK")
(fw:test:button-push "OK") (wait-for-new-frame tp-dialog)
(wait-for-new-frame tp-dialog)) (do-execute drs-frame)
(do-execute drs-frame)
(define got (fetch-output drs-frame))
(let ([got (fetch-output drs-frame)] (define expected (format "Teachpack: ~a.\n1" (path->string teachpack)))
[expected (format "Teachpack: ~a.\n1" (unless (equal? got expected)
(path->string teachpack))]) (printf "FAILED built in teachpack test: ~a\n" (path->string teachpack))
(unless (equal? got expected) (printf " got: ~s\n expected: ~s\n" got expected)))))
(printf "FAILED built in teachpack test: ~a\n" (path->string teachpack)) (define (test-teachpacks an-image-tp)
(printf " got: ~s\n expected: ~s\n" got expected)))))))] (define-values (dir name dir?) (split-path an-image-tp))
[test-teachpacks (for ([file (in-list (directory-list dir))])
(lambda (paths) (test-teachpack dir file)))
(for-each (lambda (dir) (set-language-level! '("Advanced Student"))
(for-each (test-teachpack dir) (do-execute drs-frame)
(directory-list dir))) (test-teachpacks (collection-file-path "image.rkt" "teachpack" "2htdp"))
paths))] (test-teachpacks (collection-file-path "image.rkt" "teachpack" "htdp")))
[teachpack-dir (normalize-path (collection-path "teachpack"))])
(set-language-level! '("Advanced Student"))
(do-execute drs-frame)
(test-teachpacks (list (build-path teachpack-dir "2htdp")
(build-path teachpack-dir "htdp")))))
(define (find/select-relevant-choice tp-dialog tp-string) (define (find/select-relevant-choice tp-dialog tp-string)
(define lb (define lb