From 0e5c7ae9b0e73edb5efcb9d334760ff2171d17ab Mon Sep 17 00:00:00 2001
From: Juho Snellman <jsnell@iki.fi>
Date: Wed, 3 Aug 2005 11:36:42 +0000
Subject: [PATCH] 0.9.3.20: 	Merge sbcl-devel "Patch: non-escaped pathname
 printing" by Kevin Reid

---
 NEWS                          |  2 ++
 src/code/target-pathname.lisp |  6 +++++-
 tests/pathnames.impure.lisp   | 18 ++++++++++++++++++
 version.lisp-expr             |  2 +-
 4 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/NEWS b/NEWS
index 4eceb3bc7..d59fb7f4f 100644
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,8 @@ changes in sbcl-0.9.4 relative to sbcl-0.9.3:
     *DEBUGGER-HOOK* => *DEBUGGER-HOOK* is not run when the debugger
     is disabled
   * bug fix: degree sign (<U00B0>) could not be encoded in KOI8-R.
+  * bug fix: correct pathname printing with printer escaping is on.
+    (thanks to Kevin Reid)
 
 changes in sbcl-0.9.3 relative to sbcl-0.9.2:
   * New feature: Experimental support for bivalent streams: streams
diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index b11d04c81..8c0f0fa12 100644
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -44,7 +44,11 @@
   (let ((namestring (handler-case (namestring pathname)
                       (error nil))))
     (if namestring
-        (format stream "#P~S" (coerce namestring '(simple-array character (*))))
+        (format stream
+                (if (or *print-readably* *print-escape*)
+                    "#P~S"
+                    "~A")
+                (coerce namestring '(simple-array character (*))))
         (print-unreadable-object (pathname stream :type t)
           (format stream
                   "~@<(with no namestring) ~_:HOST ~S ~_:DEVICE ~S ~_:DIRECTORY ~S ~
diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index b4a9af5ae..07f4f317b 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -339,5 +339,23 @@
 ;;; bug reported by Artem V. Andreev: :WILD not handled in unparsing
 ;;; directory lists.
 (assert (equal (namestring #p"/tmp/*/") "/tmp/*/"))
+
+;;; Printing of pathnames; see CLHS 22.1.3.1. This section was started
+;;; to confirm that pathnames are printed as their namestrings under
+;;; :escape nil :readably nil.
+(loop for (pathname expected . vars) in
+      `((#p"/foo" "#P\"/foo\"")
+        (#p"/foo" "#P\"/foo\"" :readably nil)
+        (#p"/foo" "#P\"/foo\"" :escape nil)
+        (#p"/foo" "/foo"       :readably nil :escape nil))
+      for actual = (with-standard-io-syntax
+                     (apply #'write-to-string pathname vars))
+      do (assert (string= expected actual)
+                 ()
+                 "~S should be ~S, was ~S"
+                 (list* 'write-to-string pathname vars)
+                 expected
+                 actual))
+
 ;;;; success
 (quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index ac022b877..a1334c51e 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.3.19"
+"0.9.3.20"
-- 
2.11.4.GIT