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