From 0e4b15d65c46653b1ea222dcbf12d635d59b36c7 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 4 Oct 2012 22:39:35 +0300 Subject: [PATCH] fix PARSE-NATIVE-NAMESTRING :JUNK-ALLOWED T (and word-wrap NEWS) --- NEWS | 18 ++++++++++-------- src/code/target-pathname.lisp | 2 +- tests/filesys.pure.lisp | 9 +++++++++ 3 files changed, 20 insertions(+), 9 deletions(-) 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 -- 1.7.10.4