put the receive-sexps-port.ss file in tmp

svn: r9735

collects/tests/framework/framework-test-engine.ss

@@ -25,28 +25,27 @@
    (lambda ()
      (with-handlers ([(lambda (x) #t)
 		      (lambda (x)
-			(printf "test suite thread died: ~a~n"
+			(printf "test suite thread died: ~a\n"
 				(if (exn? x)
 				    (exn-message x)
 				    (format "~s" x))))])
        (let ([port (call-with-input-file
-		    (build-path
+                       (build-path (find-system-path 'temp-dir)
-		     (collection-path "tests" "framework")
+                                   "framework-tests-receive-sexps-port.ss")
-		     "receive-sexps-port.ss")
                      read)])
-	 (debug-printf mr-tcp "about to connect to ~a~n" port)
+	 (debug-printf mr-tcp "about to connect to ~a\n" port)
 	 (let*-values ([(in out) (tcp-connect "127.0.0.1" port)])
 	   (let loop ()
-	     (debug-printf mr-tcp "about to read~n")
+	     (debug-printf mr-tcp "about to read\n")
 	     (let ([sexp (read in)])
 	       (if (eof-object? sexp)
 		   (begin
-		     (debug-printf mr-tcp "got eof~n")
+		     (debug-printf mr-tcp "got eof\n")
 		     (close-input-port in)
 		     (close-output-port out)
 		     (exit))
 		   (begin
-		     (debug-printf mr-tcp "got expression to evaluate~n")
+		     (debug-printf mr-tcp "got expression to evaluate\n")
 		     (write
 		      (let ([these-errs (protect (lambda () (begin0 errs (set! errs null))))])
 			(if (null? these-errs)

collects/tests/framework/info.ss

@@ -1,3 +1,3 @@
 #lang setup/infotab
 
-(define compile-omit-paths '("key-specs.ss" "utils.ss" "receive-sexps-port.ss"))
+(define compile-omit-paths '("key-specs.ss" "utils.ss"))

collects/tests/framework/test-suite-utils.ss

@@ -52,31 +52,25 @@
   (define load-framework-automatically? #t)
 
   (define initial-port 6012)
-  (define port-filename (build-path
+  (define port-filename
-			 (collection-path "tests" "framework")
+    (build-path (find-system-path 'temp-dir)
-			 "receive-sexps-port.ss"))
+                "framework-tests-receive-sexps-port.ss"))
 
   (unless (file-exists? port-filename)
     (call-with-output-file port-filename
-      (lambda (port)
+      (lambda (port) (write initial-port port))))
-	(write initial-port port))))
 
   (define listener
-    (let loop ()
+    (let loop ([port (call-with-input-file port-filename read)])
-      (let ([port (call-with-input-file port-filename read)])
+      (let ([l (with-handlers ([exn:fail? (lambda (_) #f)])
-	(with-handlers ([exn:fail?
+                 (tcp-listen port))])
-			 (lambda (x)
+        (if l
-			   (let ([next (+ port 1)])
+          (begin (debug-printf mz-tcp "listening to ~a\n" port)
-			     (call-with-output-file port-filename
+                 (call-with-output-file port-filename
-			       (lambda (p)
+                   (lambda (p) (write port p)) 'truncate)
-				 (write next p))
+                 l)
-			       'truncate)
+          (begin (debug-printf mz-tcp "  tcp-listen failed for port ~a\n" port)
-			     (debug-printf mz-tcp "  tcp-listen failed for port ~a, attempting ~a~n"
+                 (loop (add1 port)))))))
-					   port
-					   next)
-			     (loop)))])
-	  (debug-printf mz-tcp "listening to ~a~n" port)
-	  (tcp-listen port)))))
 
   (define in-port #f)
   (define out-port #f)
@@ -95,7 +89,7 @@
         (path->string
          (build-path (collection-path "tests" "framework")
                      "framework-test-engine.ss")))))
-    (debug-printf mz-tcp "accepting listener~n")
+    (debug-printf mz-tcp "accepting listener\n")
     (let-values ([(in out) (tcp-accept listener)])
       (set! in-port in)
       (set! out-port out))
@@ -116,7 +110,7 @@
   (define shutdown-listener
     (lambda ()
       (shutdown-mred)
-      (debug-printf mz-tcp "closing listener~n")
+      (debug-printf mz-tcp "closing listener\n")
       (tcp-close listener)))
 
   (define shutdown-mred
@@ -177,7 +171,7 @@
 		       (or (not (char-ready? in-port))
 			   (not (eof-object? (peek-char in-port))))))
 	  (restart-mred))
-	(debug-printf messages "  ~a // ~a: sending to mred:~n" section-name test-name)
+	(debug-printf messages "  ~a // ~a: sending to mred:\n" section-name test-name)
 	(show-text sexp)
 	(with-handlers ([exn:fail?
 			 (lambda (x)
@@ -214,14 +208,14 @@
 							   (cons char (loop))))
 						     null))))))))])
 		 (read in-port))])
-	  (debug-printf messages "  ~a // ~a: received from mred:~n" section-name test-name)
+	  (debug-printf messages "  ~a // ~a: received from mred:\n" section-name test-name)
 	  (show-text answer)
 	  (unless (or (eof-object? answer)
 		      (and (list? answer)
 			   (= 2 (length answer))
 			   (memq (car answer)
 				 '(error last-error cant-read normal))))
-	    (error 'send-sexp-to-mred "unpected result from mred: ~s~n" answer))
+	    (error 'send-sexp-to-mred "unpected result from mred: ~s\n" answer))
 	  (if (eof-object? answer)
 	      (raise (make-eof-result))
 	      (case (car answer)
@@ -259,7 +253,7 @@
 						 (format "~s" x))))])
 			   (not (passed? result)))])
 	    (when failed
-	      (debug-printf schedule "FAILED ~a:~n  ~s~n" test-name result)
+	      (debug-printf schedule "FAILED ~a:\n  ~s\n" test-name result)
 	      (set! failed-tests (cons (cons section-name test-name) failed-tests))
 	      (case jump
 		[(section) (section-jump)]