Fix relative file name canonicalization with empty %LOAD-PATH entries.

[bpt/guile.git] / test-suite / tests / ports.test

diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index d4a333f..07e58f6 100644 (file)
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2,7 +2,7 @@
 ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
 ;;;;
 ;;;;   Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;;      2011 Free Software Foundation, Inc.
+;;;;      2011, 2012 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -1064,8 +1064,57 @@
            (list read read-char read-line)
            '("read" "read-char" "read-line")))
 
+\f
+
+(with-test-prefix "setvbuf"
+
+  (pass-if "line/column number preserved"
+    ;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
+    ;; line and/or column number.
+    (call-with-output-file (test-file)
+      (lambda (p)
+        (display "This is GNU Guile.\nWelcome." p)))
+    (call-with-input-file (test-file)
+      (lambda (p)
+        (and (eq? #\T (read-char p))
+             (let ((line (port-line p))
+                   (col  (port-column p)))
+               (and (= line 0) (= col 1)
+                    (begin
+                      (setvbuf p _IOFBF 777)
+                      (let ((line* (port-line p))
+                            (col*  (port-column p)))
+                        (and (= line line*)
+                             (= col col*)))))))))))
+
+\f
+
+(define-syntax-rule (with-load-path path body ...)
+  (let ((new path)
+        (old %load-path))
+    (dynamic-wind
+      (lambda ()
+        (set! %load-path new))
+      (lambda ()
+        body ...)
+      (lambda ()
+        (set! %load-path old)))))
+
+(with-test-prefix "%file-port-name-canonicalization"
+
+  (pass-if "absolute file name & empty %load-path entry"
+    ;; In Guile 2.0.5 and earlier, this would return "dev/null" instead
+    ;; of "/dev/null".  See
+    ;; <http://lists.gnu.org/archive/html/guile-devel/2012-05/msg00059.html>
+    ;; for a discussion.
+    (equal? "/dev/null"
+            (with-load-path (cons "" (delete "/" %load-path))
+              (with-fluids ((%file-port-name-canonicalization 'relative))
+                (port-filename (open-input-file "/dev/null")))))))
+
 (delete-file (test-file))
 
 ;;; Local Variables:
 ;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
+;;; eval: (put 'with-load-path 'scheme-indent-function 1)
 ;;; End: