From 484b7e437eb5949e469eda82ab08059975aa7185 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Sun, 24 Jul 2011 08:40:58 -0700 Subject: [PATCH] Split port and gport tests into separate procedures. --- tests/gtk/test-gport-performance.scm | 61 +++++++++++++++------------- 1 file changed, 32 insertions(+), 29 deletions(-) diff --git a/tests/gtk/test-gport-performance.scm b/tests/gtk/test-gport-performance.scm index 24babca2d..490789781 100644 --- 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. (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 -- 2.25.1