Split port and gport tests into separate procedures.

diff --git a/tests/gtk/test-gport-performance.scm b/tests/gtk/test-gport-performance.scm
index 24babca2de85a2337aaa45b767465fd411512458..49078978106e863bcd85be6dc0bedda507b689e3 100644 (file)
--- a/tests/gtk/test-gport-performance.scm
+++ b/tests/gtk/test-gport-performance.scm
@@ -24,40 +24,46 @@ USA.
 
 |#
 
-;;;; Tests of port (character i/o) performance.
-
-(declare (usual-integrations))
+;;;; Test gfile port performance.
 \f
 (load-option 'Gtk)
 
 ;; The number of trials for each test.
 (define repeats 7)
 
+(define (compare-gport-performance)
+  (test-port-performance)
+  (test-gport-performance))
+
+(define test-port-performance
+  (let ((cwd (directory-pathname (current-load-pathname))))
+    (named-lambda (test-port-performance)
+      (with-working-directory-pathname cwd
+       (lambda ()
+         (note "Expressions")
+         (let ((data (test-io (make-read-exprs call-with-input-file)
+                              (make-write-exprs call-with-tmp-output-file))))
+           (note "    "(length data)" files,"
+                 " "(reduce-left + 0 (map length data))" exprs\n"))
+         (note "Lines")
+         (let ((data (test-io (make-read-lines call-with-input-file)
+                              (make-write-lines call-with-tmp-output-file))))
+           (note "    "(length data)" lines\n")))))))
+
 (define test-gport-performance
   (let ((cwd (directory-pathname (current-load-pathname))))
     (named-lambda (test-gport-performance)
-      (with-working-directory-pathname cwd test))))
-
-(define (test)
-  (note "Expressions")
-  (let ((data (test-io (make-read-exprs call-with-input-file)
-                      (make-write-exprs call-with-tmp-output-file))))
-    (note "    "(length data)" files,"
-         " "(reduce-left + 0 (map length data))" exprs\n"))
-  (note "Lines")
-  (let ((data (test-io (make-read-lines call-with-input-file)
-                      (make-write-lines call-with-tmp-output-file))))
-    (note "    "(length data)" lines\n"))
-
-  (note "Expressions via GIO")
-  (let ((data (test-io (make-read-exprs call-with-input-gfile)
-                      (make-write-exprs call-with-tmp-output-gfile))))
-    (note "    "(length data)" files,"
-         " "(reduce-left + 0 (map length data))" exprs\n"))
-  (note "Lines via GIO")
-  (let ((data (test-io (make-read-lines call-with-input-gfile)
-                      (make-write-lines call-with-tmp-output-gfile))))
-    (note "    "(length data)" lines\n")))
+      (with-working-directory-pathname cwd
+       (lambda ()
+         (note "Expressions via GIO")
+         (let ((data (test-io (make-read-exprs call-with-input-gfile)
+                              (make-write-exprs call-with-tmp-output-gfile))))
+           (note "    "(length data)" files,"
+                 " "(reduce-left + 0 (map length data))" exprs\n"))
+         (note "Lines via GIO")
+         (let ((data (test-io (make-read-lines call-with-input-gfile)
+                              (make-write-lines call-with-tmp-output-gfile))))
+           (note "    "(length data)" lines\n")))))))
 
 (define (test-io read write)
   (let ((data (read)))
@@ -161,7 +167,4 @@ USA.
     (if (<= i n)
        (begin (procedure i)
               (loop (1+ i)))))
-  (loop 1))
-
-;(register-test 'port-performance test-gport-performance)
-;(test-gport-performance)
\ No newline at end of file
+  (loop 1))
\ No newline at end of file