Rename test-{,g}port-performance.scm.

diff --git a/tests/gtk/test-port-performance.scm b/tests/gtk/test-gport-performance.scm
similarity index 83%
rename from tests/gtk/test-port-performance.scm
rename to tests/gtk/test-gport-performance.scm
index e7b64ec6431539155ea41a68502c05a3a5130e94..bbb76702621ef23b5b5ffb0c48ed6f6aadfe1677 100644 (file)
--- a/tests/gtk/test-port-performance.scm
+++ b/tests/gtk/test-gport-performance.scm
@@ -76,15 +76,17 @@ USA.
 (define (make-read-exprs with-input-port)
   (named-lambda (read-exprs)
     (map (lambda (file)
-        (with-input-port
-         file
-         (lambda (port)
-           (let loop ()
-             (let ((obj (read port)))
-               (if (eof-object? obj)
-                   '()
-                   (cons obj (loop))))))))
-       (directory-read "../../src/runtime/*.scm"))))
+          (with-input-port
+           file
+           (lambda (port)
+             (let loop ()
+               (let ((obj (read port)))
+                 (if (eof-object? obj)
+                     '()
+                     (cons obj (loop))))))))
+        (directory-read
+         (merge-pathnames (->simple-pathname "../../src/runtime/")
+                          "*.scm")))))
 
 (define (make-write-exprs with-output-port)
   (named-lambda (write-exprs data)
@@ -117,17 +119,22 @@ USA.
 
 (define (call-with-input-gfile pathname receiver)
   (let* ((port ((access open-input-gfile (->environment '(gtk)))
-               (string-append "file://" (->truename* pathname))))
+               (string-append "file://" (->simple-namestring pathname))))
         (value (receiver port)))
     (close-input-port port)
     value))
 
-(define-integrable (->truename* pathname)
-  (let loop ((simpler (pathname-simplify (->truename pathname))))
+(define-integrable (->simple-namestring pathname)
+  (->namestring (->simple-pathname pathname)))
+
+(define (->simple-pathname pathname)
+  (let loop ((simpler (pathname-simplify
+                      (merge-pathnames pathname (working-directory-pathname))))
+            (count 1))
     (let ((again (pathname-simplify simpler)))
-      (if (pathname=? again simpler)
-         (->namestring again)
-         (loop again)))))
+      (cond ((fix:> count 100) (error "Could not simplify:" pathname))
+           ((pathname=? again simpler) again)
+           (else (loop again (fix:1+ count)))))))
 
 (define (call-with-tmp-output-file receiver)
   (call-with-temporary-file-pathname
@@ -138,7 +145,8 @@ USA.
   (call-with-temporary-file-pathname
    (lambda (pathname)
      (let* ((port ((access open-output-gfile (->environment '(gtk)))
-                  (string-append "file://" (->truename* pathname))))
+                  (string-append "file://"
+                                 (->simple-namestring pathname))))
            (value (receiver port)))
        (close-output-port port)
        value))))
@@ -156,4 +164,4 @@ USA.
   (loop 1))
 
 ;(register-test 'port-performance test-port-performance)
-(test-port-performance)
\ No newline at end of file
+;(test-port-performance)
\ No newline at end of file