From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 4 Oct 2010 10:43:39 +0000 (+0000)
Subject: 1.0.43.22: better errors for invalid :EXTERNAL-FORMAT arguments
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=eb65b71f52bcc7067414d692ae2f127d742a7ef5;p=sbcl.git

1.0.43.22: better errors for invalid :EXTERNAL-FORMAT arguments

 Affects OPEN & RUN-PROGRAM. String <-> octets conversions did
 the right thing already.
---

diff --git a/NEWS b/NEWS
index 378236d..29ddb9d 100644
--- a/NEWS
+++ b/NEWS
@@ -24,6 +24,7 @@ changes relative to sbcl-1.0.43:
   * bug fix: non-unicode builds no longer fail (broken since 1.0.36.15).
   * bug fix: compile-times no longer scale linearly with the size of
     quoted lists in source-code. (lp#654289)
+  * bug fix: better errors for unknown external-formats in OPEN. (lp#561974)
 
 changes in sbcl-1.0.43 relative to sbcl-1.0.42:
   * incompatible change: FD-STREAMS no longer participate in the serve-event
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 82da2b3..8fc27f7 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -851,7 +851,7 @@
 
 (defun get-external-format-or-lose (external-format)
   (or (get-external-format external-format)
-      (error "Undefined external-format ~A" external-format)))
+      (error "Undefined external-format: ~S" external-format)))
 
 (defun external-format-keyword (external-format)
   (typecase external-format
@@ -871,17 +871,16 @@
 ;;; number of bytes per element.
 (defun pick-output-routine (type buffering &optional external-format)
   (when (subtypep type 'character)
-    (let ((entry (get-external-format external-format)))
-      (when entry
-        (return-from pick-output-routine
-          (values (ecase buffering
-                    (:none (ef-write-char-none-buffered-fun entry))
-                    (:line (ef-write-char-line-buffered-fun entry))
-                    (:full (ef-write-char-full-buffered-fun entry)))
-                  'character
-                  1
-                  (ef-write-n-bytes-fun entry)
-                  (canonize-external-format external-format entry))))))
+    (let ((entry (get-external-format-or-lose external-format)))
+      (return-from pick-output-routine
+        (values (ecase buffering
+                  (:none (ef-write-char-none-buffered-fun entry))
+                  (:line (ef-write-char-line-buffered-fun entry))
+                  (:full (ef-write-char-full-buffered-fun entry)))
+                'character
+                1
+                (ef-write-n-bytes-fun entry)
+                (canonize-external-format external-format entry)))))
   (dolist (entry *output-routines*)
     (when (and (subtypep type (first entry))
                (eq buffering (second entry))
@@ -1221,14 +1220,13 @@
 ;;; bytes per element (and for character types string input routine).
 (defun pick-input-routine (type &optional external-format)
   (when (subtypep type 'character)
-    (let ((entry (get-external-format external-format)))
-      (when entry
-        (return-from pick-input-routine
-          (values (ef-read-char-fun entry)
-                  'character
-                  1
-                  (ef-read-n-chars-fun entry)
-                  (canonize-external-format external-format entry))))))
+    (let ((entry (get-external-format-or-lose external-format)))
+      (return-from pick-input-routine
+        (values (ef-read-char-fun entry)
+                'character
+                1
+                (ef-read-n-chars-fun entry)
+                (canonize-external-format external-format entry)))))
   (dolist (entry *input-routines*)
     (when (and (subtypep type (first entry))
                (or (not (fourth entry))
diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp
index 2eff834..11586b9 100644
--- a/tests/external-format.impure.lisp
+++ b/tests/external-format.impure.lisp
@@ -991,5 +991,34 @@
       (write-string string s))
     (with-open-file (s *test-path* :external-format :utf-32be)
       (assert (string= " ???? " (read-line s))))))
+
+(with-test (:name :invalid-external-format)
+  (labels ((test-error (e)
+             (assert (typep e 'error))
+             (unless (equal "Undefined external-format: :BAD-FORMAT"
+                            (princ-to-string e))
+               (error "Bad error:~%  ~A" e)))
+           (test (direction)
+             (test-error
+              (handler-case
+                  (open "/dev/null" :direction direction :external-format :bad-format
+                        :if-exists :overwrite)
+                (error (e) e)))))
+    (test :input)
+    (test :output)
+    (test :io)
+    (test-error
+     (handler-case
+         (run-program "sh" '() :input :stream :external-format :bad-format)
+       (error (e) e)))
+    (test-error
+     (handler-case
+         (string-to-octets "foobar" :external-format :bad-format)
+       (error (e) e)))
+    (test-error
+     (let ((octets (string-to-octets "foobar" :external-format :latin1)))
+       (handler-case
+           (octets-to-string octets :external-format :bad-format)
+         (error (e) e))))))
 
 ;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 162c5fb..f0865de 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".)
-"1.0.43.21"
+"1.0.43.22"