[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: unparse-win32-namestring: more file-error.
From:       stassats via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2017-11-23 17:18:14
Message-ID: 1511457495.360664.26867 () sfp-scm-6 ! v30 ! ch3 ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  4e6b77eaa5a6213710562fc4618d4d6a63ac378d (commit)
      from  673fceb104ee4182c6a09eff71959249f20eefac (commit)

- Log -----------------------------------------------------------------
commit 4e6b77eaa5a6213710562fc4618d4d6a63ac378d
Author: Stas Boukarev <stassats@gmail.com>
Date:   Thu Nov 23 19:58:16 2017 +0300

    unparse-win32-namestring: more file-error.
---
 src/code/win32-pathname.lisp | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/src/code/win32-pathname.lisp b/src/code/win32-pathname.lisp
index fdebefc..0f240ac 100644
--- a/src/code/win32-pathname.lisp
+++ b/src/code/win32-pathname.lisp
@@ -284,8 +284,10 @@
                                    username condition)))))
                    (when (and (or absolutep devicep)
                               (not (string-equal device (pathname-device home))))
-                     (error "Device in homedir ~S conflicts which device ~S"
-                            home device))
+                     (no-native-namestring-error
+                      pathname
+                      "Device in homedir ~S conflicts which device ~S"
+                      home device))
                    (write-string (native-namestring home) s)))
                 ;; namestring of user-homedir-pathname already has
                 ;; // at the end
@@ -299,8 +301,9 @@
              do (typecase piece
                   ((member :up :back) (write-string ".." s))
                   (string (write-string piece s))
-                  (t (error "Bad directory segment in NATIVE-NAMESTRING: ~S."
-                            piece)))
+                  (t (no-native-namestring-error pathname
+                                                 "Bad directory segment in NATIVE-NAMESTRING: ~S."
+                                                 piece)))
              when (or subdirs seperator-after-directory-p)
              do (write-char #\\ s))
        (write-string (unparse-native-physical-file pathname) s)
@@ -319,6 +322,7 @@
      'simple-string)))
 
 ;;; FIXME.
+;;; ... fix what?
 (defun unparse-win32-enough (pathname defaults)
   (declare (type pathname pathname defaults))
   (flet ((lose ()

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL

------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]