[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] master: Improve SIMPLE-{FILE,STREAM}-PERROR
From: Jan Moringen via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date: 2017-12-31 15:07:56
Message-ID: 1514732876.935028.31732 () sfp-scm-2 ! v30 ! ch3 ! sourceforge ! com
[Download RAW message or body]
The branch "master" has been updated in SBCL:
via 4b5891d20ed7b9fbf59aa09cfef55b4a624dbf2b (commit)
from c1223ee5816663165218ebec1d4588fd6c539147 (commit)
- Log -----------------------------------------------------------------
commit 4b5891d20ed7b9fbf59aa09cfef55b4a624dbf2b
Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date: Sun Dec 31 13:09:07 2017 +0100
Improve SIMPLE-{FILE,STREAM}-PERROR
And get rid of the strange two-stage FORMATting in QUERY-FILE-SYSTEM.
---
src/code/fd-stream.lisp | 29 ++++++++++++++---------------
src/code/filesys.lisp | 32 ++++++++++++++------------------
2 files changed, 28 insertions(+), 33 deletions(-)
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index e184da1..fbbf36b 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -444,19 +444,22 @@
of bytes per element.")
;;; common idioms for reporting low-level stream and file problems
-(defun simple-stream-perror (note-format stream errno)
+(defun simple-stream-perror (format-control stream &optional errno &rest format-arguments)
(declare (optimize allow-non-returning-tail-call))
(error 'simple-stream-error
:stream stream
- :format-control "~@<~?: ~2I~_~A~:>"
- :format-arguments (list note-format (list stream) (strerror errno))))
-(defun simple-file-perror (note-format pathname errno)
+ :format-control "~@<~?~@[: ~2I~_~A~]~:>"
+ :format-arguments (list format-control
+ (list* stream format-arguments)
+ (when errno (strerror errno)))))
+(defun simple-file-perror (format-control pathname &optional errno &rest format-arguments)
(declare (optimize allow-non-returning-tail-call))
(error 'simple-file-error
:pathname pathname
- :format-control "~@<~?: ~2I~_~A~:>"
- :format-arguments
- (list note-format (list pathname) (strerror errno))))
+ :format-control "~@<~?~@[: ~2I~_~A~]~:>"
+ :format-arguments (list format-control
+ (list* pathname format-arguments)
+ (when errno (strerror errno)))))
(defun c-string-encoding-error (external-format code)
(declare (optimize allow-non-returning-tail-call))
@@ -2463,11 +2466,9 @@
(okay
(when (and output (= (logand orig-mode #o170000)
#o40000))
- (error 'simple-file-error
- :pathname pathname
- :format-control
- "can't open ~S for output: is a directory"
- :format-arguments (list namestring)))
+ (simple-file-perror
+ "can't open ~A for output: is a directory"
+ pathname))
(setf mode (logand orig-mode #o777))
t)
((eql err/dev sb!unix:enoent)
@@ -2702,9 +2703,7 @@
(case operation
(:file-position
(if arg1
- (error 'simple-stream-error
- :format-control "~S is not positionable"
- :format-arguments (list stream))
+ (simple-stream-perror "~S is not positionable" stream)
(fd-stream-get-file-position stream)))
(t ; call next method
(fd-stream-misc-routine stream operation arg1 arg2))))
diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 0c0bb8a..d65ae9b 100644
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -288,17 +288,14 @@
(pathname pathspec)
(sane-default-pathname-defaults)))))
(when (wild-pathname-p pathname)
- (error 'simple-file-error
- :pathname pathname
- :format-control "~@<can't find the ~A of wild pathname ~A~
- (physicalized from ~A).~:>"
- :format-arguments (list query-for pathname pathspec)))
- (macrolet ((fail (note-format pathname errno)
- ;; Do this as a macro to avoid evaluating format
- ;; calls when ERROP is NIL
- `(if errorp
- (simple-file-perror ,note-format ,pathname ,errno)
- (return-from query-file-system nil))))
+ (simple-file-perror
+ "Can't find the ~*~A~2:* of wild pathname ~A~* (physicalized from ~A)."
+ pathname nil query-for pathspec))
+ (macrolet ((fail (format-control pathname errno &rest format-arguments)
+ `(if errorp
+ (simple-file-perror
+ ,format-control ,pathname ,errno ,@format-arguments)
+ (return-from query-file-system nil))))
(let ((filename (native-namestring pathname :as-file t)))
#!+win32
(case query-for
@@ -317,12 +314,12 @@
(pathname-host pathname)
(sane-default-pathname-defaults)
:as-directory (eq :directory kind)))
- (fail (format nil "Failed to find the ~A of ~~A" query-for) filename
- (sb!win32:get-last-error)))))
+ (fail "Failed to find the ~A of ~A"
+ filename (sb!win32:get-last-error) query-for))))
(:write-date
(or (sb!win32::native-file-write-date filename)
- (fail (format nil "Failed to find the ~A of ~~A" query-for) filename
- (sb!win32:get-last-error)))))
+ (fail "Failed to find the ~A of ~A"
+ filename (sb!win32:get-last-error) query-for))))
#!-win32
(multiple-value-bind (existsp errno ino mode nlink uid gid rdev size
atime mtime)
@@ -401,9 +398,8 @@
(:author (sb!unix:uid-username uid))
(:write-date (+ unix-to-universal-time mtime))))))
;; If we're still here, the file doesn't exist; error.
- (fail
- (format nil "Failed to find the ~A of ~~A" query-for)
- pathspec errno)))
+ (fail "Failed to find the ~A of ~A"
+ pathspec errno query-for)))
(if existsp
(case query-for
(:existence (parse filename))
-----------------------------------------------------------------------
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]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic