another attempt to get the drscheme gui test suite in shape to be run by drdr

svn: r18004

collects/tests/drscheme/drscheme-test-util.ss

@@ -11,7 +11,7 @@
    [use-get/put-dialog (-> (-> any) path? void?)]
    [set-module-language! (->* () (boolean?) void?)])
   
-  (provide fire-up-drscheme
+  (provide fire-up-drscheme-and-run-tests
            save-drscheme-window-as
            do-execute
            test-util-error
@@ -622,13 +622,35 @@
   ;; but just to print and return.
   (define orig-display-handler (error-display-handler))
   
-  (define (fire-up-drscheme)
+  (define (fire-up-drscheme-and-run-tests run-test)
+    (let ()
+      ;; change the preferences system so that it doesn't write to 
+      ;; a file; partly to avoid problems of concurrency in drdr
+      ;; but also to make the test suite easier for everyone to run.
+      (let ([prefs-table (make-hash)])
+	(fw:preferences:low-level-put-preferences
+	 (lambda (names vals)
+	   (for-each (lambda (name val) (hash-set! prefs-table name val))
+		     names vals)))
+	(fw:preferences:low-level-get-preference 
+	 (lambda (name [fail (lambda () #f)])
+	   (hash-ref prefs-table name fail))))
+	 
       (dynamic-require 'drscheme #f)
 
-    ;; reset the uncaught exception handler to be sure we kill everything (drscheme sets it)
+      ;; set all preferences to their defaults (some pref values may have
+      ;; been read by this point, but hopefully that won't affect much
+      ;; of the startup of drscheme)
+      (fw:preferences:restore-defaults)
+
+      (thread (λ () 
+		 (let ([orig-display-handler (error-display-handler)])
 		   (uncaught-exception-handler
 		    (λ (x)
 		       (if (exn? x)
 			   (orig-display-handler (exn-message x) x)
 			   (fprintf (current-error-port) "uncaught exception ~s\n" x))
 		       (exit 1))))
+		 (run-test)
+		 (exit)))
+      (yield (make-semaphore 0))))

collects/tests/drscheme/io.ss

@@ -183,9 +183,7 @@ add this test:
 (define drs-frame #f)
 (define interactions-text #f)
 
-(let ([s (make-semaphore)])
-  (fire-up-drscheme)
-  (thread
+(fire-up-drscheme-and-run-tests
  (λ ()
     (set! drs-frame (wait-for-drscheme-frame))
     (set! interactions-text  (send drs-frame get-interactions-text))
@@ -194,9 +192,6 @@ add this test:
     (do-execute drs-frame)
     
     (output-err-port-checking) ;; must come first
-     ;(long-io/execute-test)
-     (reading-test)
-     (semaphore-post s)))
-  (yield s)
-  (exit))
+    ;;(long-io/execute-test)
+    (reading-test)))
 

collects/tests/drscheme/language-test.ss

@@ -1352,7 +1352,4 @@ the settings above should match r5rs
   (go pretty-big)
   (go r5rs))
 
-(let ()
-  (fire-up-drscheme)
-  (thread (λ () (run-test) (exit)))
-  (yield (make-semaphore)))
+(fire-up-drscheme-and-run-tests run-test)

collects/tests/drscheme/module-lang-test-utils.ss

@@ -129,7 +129,6 @@
                         error-ranges-expected
                         (send interactions-text get-error-ranges))))])))))
 
-
 (define drs 'not-yet-drs-frame)
 (define interactions-text 'not-yet-interactions-text)
 (define definitions-text 'not-yet-definitions-text)

collects/tests/drscheme/module-lang-test.ss

@@ -141,7 +141,7 @@
            (provide s)
            (define-syntax (s stx) e))}
       @t{(require m) s}
-      @rx{module-lang-test-tmp2.ss:1:[67][90]: compile: bad syntax;
+      @rx{compile: bad syntax;
           literal data is not allowed, because no #%datum syntax transformer
           is bound in: 1$})
 (test @t{(module tmp mzscheme
@@ -247,11 +247,7 @@
   f
   (f)
 --
-      #t
-      #:error-ranges 
-      (λ (defs ints)
-        (list (make-srcloc ints 3 3 107 1)
-              (make-srcloc ints 3 2 106 3))))
+      #t)
 
 ;; test protection against user-code changing the namespace
 (test @t{#lang scheme/base
@@ -265,7 +261,4 @@
 
 
 (require "drscheme-test-util.ss")
-(let ()
-  (fire-up-drscheme)
-  (thread (λ () (run-test) (exit)))
-  (yield (make-semaphore 0)))
+(fire-up-drscheme-and-run-tests run-test)

collects/tests/drscheme/repl-test.ss

@@ -73,7 +73,7 @@ This produces an ACK message
                                  backtrace-image-string
                                  " "
                                  file-image-string
-                                 " ../../mred/private/snipfile.ss:"))
+                                 " .*mred/private/snipfile.ss:"))
                   "[0-9]+:[0-9]+: "
                   (regexp-quote str))))
 
@@ -190,8 +190,8 @@ This produces an ACK message
             "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
             "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: reference to undefined identifier: xx"
             "reference to undefined identifier: xx"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
            'definitions
            #f
            void
@@ -266,8 +266,8 @@ This produces an ACK message
             "define-values: cannot change constant identifier: +"
             "define-values: cannot change constant identifier: +"
             "define-values: cannot change constant identifier: +"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+")
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+"
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: define-values: cannot change constant identifier: \\+")
            'interactions
            #f
            void
@@ -305,8 +305,8 @@ This produces an ACK message
             "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
             "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:7: reference to undefined identifier: xx"
             "reference to undefined identifier: xx"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
            'definitions
            #f
            void
@@ -350,8 +350,8 @@ This produces an ACK message
             "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
             "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:2:0: reference to undefined identifier: xx"
             "reference to undefined identifier: xx"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
            'definitions
            #f
            void
@@ -417,8 +417,8 @@ This produces an ACK message
             "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x"
             "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: reference to undefined identifier: x"
             "reference to undefined identifier: x"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
            'definitions
            #f
            void
@@ -457,8 +457,8 @@ This produces an ACK message
             "{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #<void>"
             "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: expt: expected argument of type <number>; given #<void>"
             "expt: expected argument of type <number>; given #<void>"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>")
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>"
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>")
            'definitions
            #f
            void
@@ -507,8 +507,8 @@ This produces an ACK message
             "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x"
             "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:4: reference to undefined identifier: x"
             "1\n2\nreference to undefined identifier: x"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x"
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: x")
            'definitions
            #f
            void
@@ -620,8 +620,8 @@ This produces an ACK message
      "{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f\n15"
      "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:5:19: expt: expected argument of type <number>; given #f\n15"
      "expt: expected argument of type <number>; given #f\n15"
-     #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15"
-     #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15")
+     #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15"
+     #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15")
     'definitions
     #f
     void
@@ -644,12 +644,12 @@ This produces an ACK message
    
    ;; should produce a syntax object with a turn-down triangle.
    (mktest "(write (list (syntax x)))" 
-           (#rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
-            #rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
-            #rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:21.*>\"})"
-            #rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
-            #rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:21.*>\"})"
-            #rx"({embedded \".#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:21.*>\"})")
+           (#rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
+            #rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
+            #rx"({embedded \".#<syntax:.*repl-test-tmp3.ss:1:21.*>\"})"
+            #rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
+            #rx"({embedded \".#<syntax:.*repl-test-tmp.ss:1:21.*>\"})"
+            #rx"({embedded \".#<syntax:.*repl-test-tmp3.ss:1:21.*>\"})")
            'interactions
            #f
            void
@@ -685,12 +685,12 @@ This produces an ACK message
    
    (mktest "(parameterize ([current-output-port (open-output-string)]) (fprintf (current-error-port) \"~e\" #'foot))"
            
-           (#rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
-            #rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
-            #rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:96.*>"
-            #rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
-            #rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp.ss:1:96.*>"
-            #rx"#<syntax:.*/collects/tests/drscheme/repl-test-tmp3.ss:1:96.*>")
+           (#rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
+            #rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
+            #rx"#<syntax:.*repl-test-tmp3.ss:1:96.*>"
+            #rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
+            #rx"#<syntax:.*repl-test-tmp.ss:1:96.*>"
+            #rx"#<syntax:.*repl-test-tmp3.ss:1:96.*>")
            'interactions
            #f
            void
@@ -719,8 +719,8 @@ This produces an ACK message
      "{stop-multi.png} {stop-22x22.png} expt: expected argument of type <number>; given #f"
      "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:6:15: expt: expected argument of type <number>; given #f"
      "expt: expected argument of type <number>; given #f"
-     #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f"
-     #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f")
+     #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f"
+     #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f")
     'definitions
     #f
     void
@@ -796,8 +796,8 @@ This produces an ACK message
             "{stop-multi.png} {stop-22x22.png} procedure application: expected procedure, given: 3; arguments were: 3"
             "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:3:13: procedure application: expected procedure, given: 3; arguments were: 3"
             "procedure application: expected procedure, given: 3; arguments were: 3"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3")
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3"
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3")
            'definitions
            #f
            void
@@ -898,8 +898,8 @@ This produces an ACK message
             "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx"
             "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.ss:1:0: reference to undefined identifier: xx"
             "reference to undefined identifier: xx"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
-            #rx"{stop-multi.png} {stop-22x22.png} ../../mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx"
+            #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.ss:[0-9]+:[0-9]+: reference to undefined identifier: xx")
            'definitions
            #f
            void
@@ -1069,7 +1069,8 @@ This produces an ACK message
 (define backtrace-image-string "{stop-multi.png}")
 (define file-image-string "{stop-22x22.png}")
 
-(define tmp-load-directory
+(define tmp-load-directory (find-system-path 'temp-dir)
+  #;
   (normal-case-path
    (normalize-path 
     (collection-path "tests" "drscheme"))))
@@ -1080,8 +1081,6 @@ This produces an ACK message
 (define tmp-load3-short-filename "repl-test-tmp3.ss")
 (define tmp-load3-filename (build-path tmp-load-directory tmp-load3-short-filename))
 
-tmp-load-filename
-
 (define (cleanup-tmp-files)
   (when (file-exists? tmp-load-filename) (delete-file tmp-load-filename))
   (when (file-exists? tmp-load3-filename) (delete-file tmp-load3-filename)))
@@ -1515,13 +1514,10 @@ tmp-load-filename
       (string-append a b)))
 
 
-(let ()
-  (fire-up-drscheme)
-  (wait-for-drscheme-frame) ;; after this point, it is safe to set the exit handler
-  (exit-handler
+(exit-handler
  (let ([eh (exit-handler)])
    (λ (val)
       (cleanup-tmp-files)
       (eh val))))
-  (thread (λ () (run-test) (exit)))
-  (yield (make-semaphore 0)))
+
+(fire-up-drscheme-and-run-tests run-test)

collects/tests/drscheme/run.sh

@@ -0,0 +1,7 @@
+#!/bin/sh -x
+mred module-lang-test.ss &&
+mred repl-test.ss &&
+mred io.ss &&
+mred language-test.ss &&
+mred syncheck-test.ss &&
+mred teachpack.ss

collects/tests/drscheme/syncheck-test.ss

@@ -849,8 +849,7 @@ trigger runtime errors in check syntax.
                  (list '((27 33) (19 26) (36 49) (53 59) (64 66))))))
   
   (define (main)
-    (let ([s (make-semaphore 0)])
-      (thread
+    (fire-up-drscheme-and-run-tests
      (λ ()
 	(let ([drs (wait-for-drscheme-frame)])
 	  (set-language-level! (list "Pretty Big"))
@@ -864,13 +863,7 @@ trigger runtime errors in check syntax.
 	      (preferences:set 'framework:coloring-active #t)
 	      (send defs save-file) ;; clear out autosave
 	      (send defs set-filename #f)
-               (delete-file filename)
-               ;; let the app die.
-               (semaphore-post s))))))
-      (fire-up-drscheme)
-      (yield s)
-      (printf "Tests complete.\n")
-      (exit)))
+	      (delete-file filename)))))))
   
   (define ((run-one-test save-dir) test)
     (let* ([drs (wait-for-drscheme-frame)]

collects/tests/drscheme/teachpack.ss

@@ -238,7 +238,4 @@
   ;(bad-tests)
   (test-built-in-teachpacks))
 
-(let ()
-  (fire-up-drscheme)
-  (thread (λ () (run-test) (exit)))
-  (yield (make-semaphore)))
+(fire-up-drscheme-and-run-tests run-test)