From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu, 4 Oct 2012 19:39:35 +0000 (+0300)
Subject: fix PARSE-NATIVE-NAMESTRING :JUNK-ALLOWED T
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0e4b15d65c46653b1ea222dcbf12d635d59b36c7;hp=b35d5f4c386c3e573ff752de1c3770da7d8034f6;p=sbcl.git

fix PARSE-NATIVE-NAMESTRING :JUNK-ALLOWED T

 (and word-wrap NEWS)
---

diff --git a/NEWS b/NEWS
index abc3e81..29bfc32 100644
--- a/NEWS
+++ b/NEWS
@@ -1,13 +1,15 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.1.0:
-  * enhancement: WITH-COMPILATION-UNIT no longer grabs the world-lock. (COMPILE and
-    COMPILE-FILE still do.)
-  * bug fix: SB-CLTL2:MACROEXPAND-ALL correctly handles shadowing of symbol-macros
-    by lexical bindings.
-  * bug fix: stack allocation was prevented by high DEBUG declaration in several
-    cases.
-  * bug fix: SB-EXT:GC-LOGFILE signaled an error when no logfile was set. (thanks
-    to SANO Masatoshi)
+  * enhancement: WITH-COMPILATION-UNIT no longer grabs the world-lock.
+    (COMPILE and COMPILE-FILE still do.)
+  * bug fix: SB-CLTL2:MACROEXPAND-ALL correctly handles shadowing of
+    symbol-macros by lexical bindings.
+  * bug fix: stack allocation was prevented by high DEBUG declaration in
+    several cases.
+  * bug fix: SB-EXT:GC-LOGFILE signaled an error when no logfile was set.
+    (thanks to SANO Masatoshi)
+  * bug fix: PARSE-NATIVE-NAMESTRING performed non-native parsing when
+    :JUNK-ALLOWED was true.
 
 changes in sbcl-1.1.0 relative to sbcl-1.0.58:
   * enhancement: New variable, sb-ext:*disassemble-annotate* for controlling
diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index b791566..ed0c63d 100644
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -863,7 +863,7 @@ a host-structure or string."
   (cond
     (junk-allowed
      (handler-case
-         (%parse-namestring namestr host defaults start end nil)
+         (%parse-native-namestring namestr host defaults start end nil as-directory)
        (namestring-parse-error (condition)
          (values nil (namestring-parse-error-offset condition)))))
     (t
diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index 0c98791..ec4c35e 100644
--- a/tests/filesys.pure.lisp
+++ b/tests/filesys.pure.lisp
@@ -93,6 +93,15 @@
   (assert (equal "C:\\FOO\\BAR" (native-namestring "C:\\FOO\\BAR")))
   (assert (equal "C:\\FOO\\BAR" (native-namestring "C:\\FOO\\BAR\\" :as-file t))))
 
+(with-test (:name (:parse-native-pathname :as-directory :junk-allowed))
+  (assert
+   (equal
+    (parse-native-namestring "foo.lisp" nil *default-pathname-defaults*
+                             :as-directory t)
+    (parse-native-namestring "foo.lisp" nil *default-pathname-defaults*
+                             :as-directory t
+                             :junk-allowed t))))
+
 ;;; Test for NATIVE-PATHNAME / NATIVE-NAMESTRING stuff
 ;;;
 ;;; given only safe characters in the namestring, NATIVE-PATHNAME will