From b73613460b31c76212f6a61d76164e59be791a6c Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 15 Feb 2010 18:39:15 +0000 Subject: [PATCH] added a test that saves and reopens a file in the teaching languages svn: r18088 --- collects/tests/drscheme/drscheme-test-util.ss | 70 ------------------- collects/tests/drscheme/run.sh | 3 +- .../tests/drscheme/save-teaching-lang-file.ss | 45 ++++++++++++ 3 files changed, 47 insertions(+), 71 deletions(-) create mode 100644 collects/tests/drscheme/save-teaching-lang-file.ss diff --git a/collects/tests/drscheme/drscheme-test-util.ss b/collects/tests/drscheme/drscheme-test-util.ss index f140b7772f..a4956f530c 100644 --- a/collects/tests/drscheme/drscheme-test-util.ss +++ b/collects/tests/drscheme/drscheme-test-util.ss @@ -312,44 +312,6 @@ ;; set language level in the frontmost DrScheme frame (resets settings to defaults) ;; If `close-dialog?' it #t, (define set-language-level! - (lambda (in-language-spec [close-dialog? #t]) - (unless (and (pair? in-language-spec) - (list? in-language-spec) - (andmap (lambda (x) (or string? regexp?)) in-language-spec)) - (error 'set-language-level! "expected a non-empty list of regexps and strings for language, got: ~e" in-language-spec)) - (let ([drs-frame (get-top-level-focus-window)]) - (fw:test:menu-select "Language" "Choose Language...") - (let* ([language-dialog (wait-for-new-frame drs-frame)] - [language-choice (find-labelled-window #f hierarchical-list%)] - [b1 (box 0)] - [b2 (box 0)] - [click-on-snip - (lambda (snip) - (let* ([editor (send (send snip get-admin) get-editor)] - [between-threshold (send editor get-between-threshold)]) - (send editor get-snip-location snip b1 b2) - (let-values ([(gx gy) (send editor editor-location-to-dc-location - (unbox b1) - (unbox b2))]) - (let ([x (inexact->exact (+ gx between-threshold 1))] - [y (inexact->exact (+ gy between-threshold 1))]) - (fw:test:mouse-click 'left x y)))))]) - (send language-choice focus) - (let loop ([list-item language-choice] - [language-spec in-language-spec]) - (let* ([name (car language-spec)] - [which (filter (lambda (child) - (let* ([text (send (send child get-editor) get-text)] - [matches - (or (and (regexp? name) - (regexp-match name text)) - (and (string? name) - (string=? name text)))]) - (and matches - child))) - (send list-item get-items))]) - (when (null? which) - (error '(define set-language-level! (lambda (in-language-spec [close-dialog? #t]) (unless (and (pair? in-language-spec) (list? in-language-spec) @@ -392,38 +354,6 @@ (unless (= 1 (length which)) (error 'set-language-level! "couldn't find language: ~e, double match ~e" in-language-spec name)) - (let ([next-item (car which)]) - (cond - [(null? (rest language-spec)) - (when (is-a? next-item hierarchical-list-compound-item<%>) - (error 'set-language-level! "expected no more languages after ~e, but still are, input ~e" - name in-language-spec)) - (click-on-snip (send next-item get-clickable-snip))] - [else - (unless (is-a? next-item hierarchical-list-compound-item<%>) - (error 'set-language-level! "expected more languages after ~e, but got to end, input ~e" - name in-language-spec)) - (unless (send next-item is-open?) - (click-on-snip (send next-item get-arrow-snip))) - (loop next-item (cdr language-spec))])))) - - (with-handlers ([exn:fail? (lambda (x) (void))]) - (fw:test:button-push "Show Details")) - - (fw:test:button-push "Revert to Language Defaults") - - (when close-dialog? - (fw:test:button-push "OK") - (let ([new-frame (wait-for-new-frame language-dialog)]) - (unless (eq? new-frame drs-frame) - (error 'set-language-level! - "didn't get drscheme frame back, got: ~s (drs-frame ~s)\n" - new-frame - drs-frame)))))))) "couldn't find language: ~e, no match at ~e" - in-language-spec name)) - (unless (= 1 (length which)) - (error 'set-language-level! "couldn't find language: ~e, double match ~e" - in-language-spec name)) (let ([next-item (car which)]) (cond [(null? (cdr language-spec)) diff --git a/collects/tests/drscheme/run.sh b/collects/tests/drscheme/run.sh index 1f8cefae07..554e71708c 100644 --- a/collects/tests/drscheme/run.sh +++ b/collects/tests/drscheme/run.sh @@ -4,4 +4,5 @@ mred repl-test.ss && mred io.ss && mred language-test.ss && mred syncheck-test.ss && -mred teachpack.ss +mred teachpack.ss && +mred save-teaching-lang-file.ss diff --git a/collects/tests/drscheme/save-teaching-lang-file.ss b/collects/tests/drscheme/save-teaching-lang-file.ss new file mode 100644 index 0000000000..65690a2ec8 --- /dev/null +++ b/collects/tests/drscheme/save-teaching-lang-file.ss @@ -0,0 +1,45 @@ +#lang scheme/base +(require scheme/file + scheme/class + scheme/port + framework/test + framework/preferences) + +(require tests/drscheme/drscheme-test-util) + +(fire-up-drscheme-and-run-tests + (λ () + (let* ([drs-frame (wait-for-drscheme-frame)] + [fn (make-temporary-file "save-teaching-lang-test~a")]) + (test:menu-select "File" "New Tab") + + (let ([definitions-text (send drs-frame get-definitions-text)] + [interactions-text (send drs-frame get-interactions-text)]) + + (set-language-level! (list #rx"How to Design Programs" #rx"Beginning Student$")) + (clear-definitions drs-frame) + (send definitions-text set-filename fn) + (send definitions-text insert "(define (f x) x)\n(f 1)\n") + (test:menu-select "File" "Save Definitions") + (unless (call-with-input-file fn + (λ (p) (regexp-match #rx";;[^\n]*metadata" p))) + + (fprintf (current-error-port) "---- saved file, cut here ----\n") + (call-with-input-file fn (λ (p) (copy-port p (current-error-port)))) + (fprintf (current-error-port) "---- saved file, cut here ----\n") + (error 'save-teaching-lang-file.ss "expected the saved file to contain the word 'metadata' in a comment")) + (do-execute drs-frame) + (test:menu-select "File" "Close Tab") + (use-get/put-dialog + (λ () + (test:menu-select "File" "Open...")) + fn) + (do-execute drs-frame) + (let ([result (fetch-output + drs-frame + (send interactions-text paragraph-start-position 2) + (send interactions-text last-position))]) + (test:menu-select "File" "Close Tab") + (delete-file fn) + (unless (equal? result "1\n> ") + (error 'save-teaching-lang-file.ss "expected the program to produce 1 (followed by the prompt), got ~s" result)))))))