1.0.32.5: defend against full MAKE-ARRAY before the type system is ready

[sbcl.git] / tests / external-format.impure.lisp

diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp
index 405fea1..78285f7 100644 (file)
--- a/tests/external-format.impure.lisp
+++ b/tests/external-format.impure.lisp
@@ -17,9 +17,9 @@
 
 (defmacro do-external-formats ((xf &optional result) &body body)
   (let ((nxf (gensym)))
-    `(dolist (,nxf sb-impl::*external-formats* ,result)
-       (let ((,xf (first (first ,nxf))))
-         ,@body))))
+    `(loop for ,nxf being the hash-values of sb-impl::*external-formats*
+        do (let ((,xf (first (sb-impl::ef-names ,nxf))))
+             ,@body))))
 
 (defvar *test-path* "external-format-test.tmp")
 
@@ -287,6 +287,23 @@
     (values)))
 (delete-file *test-path*)
 
+;;; We used to call STREAM-EXTERNAL-FORMAT on the stream in the error
+;;; when printing a coding error, but that didn't work if the stream
+;;; was closed by the time the error was printed.  See sbcl-devel
+;;; "Subject: Printing coding errors for closed streams" by Zach Beane
+;;; on 2008-10-16 for more info.
+(with-test (:name (:character-coding-error-stream-external-format))
+  (flet ((first-file-character ()
+           (with-open-file (stream *test-path* :external-format :utf-8)
+             (read-char stream))))
+    (with-open-file (stream *test-path*
+                            :direction :output
+                            :if-exists :supersede
+                            :element-type '(unsigned-byte 8))
+      (write-byte 192 stream))
+    (princ-to-string (nth-value 1 (ignore-errors (first-file-character))))))
+(delete-file *test-path*)
+
 ;;; External format support in SB-ALIEN
 
 (with-test (:name (:sb-alien :vanilla))