From 4023cc8820dad1ce5efa892c5940669414c3bdec Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Wed, 14 Feb 2018 20:22:31 +0300 Subject: [PATCH] Tolerate non-simple strings when checking arguments to CERROR. Fixes lp#1749307. --- src/code/late-format.lisp | 4 ++-- src/compiler/srctran.lisp | 2 -- tests/format.pure.lisp | 12 +++++++++++- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp index ef107d650..747e178aa 100644 --- a/src/code/late-format.lisp +++ b/src/code/late-format.lisp @@ -1248,8 +1248,8 @@ ;;; inspired by that of Gerd Moellmann, and comes decorated with ;;; FIXMEs: (defun %compiler-walk-format-string (string args) - (declare (type simple-string string)) - (let ((*default-format-error-control-string* string)) + (let* ((string (coerce string 'simple-string)) + (*default-format-error-control-string* string)) (macrolet ((incf-both (&optional (increment 1)) `(progn (incf min ,increment) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 9bda2103a..7ac54a2f0 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -4524,8 +4524,6 @@ ;;; list type, a warning could be signalled. (defun check-format-args (string args fun) (declare (type string string)) - (unless (typep string 'simple-string) - (setq string (coerce string 'simple-string))) (multiple-value-bind (min max) (handler-case (sb!format:%compiler-walk-format-string string args) (sb!format:format-error (c) diff --git a/tests/format.pure.lisp b/tests/format.pure.lisp index 68b3e42cf..41173f924 100644 --- a/tests/format.pure.lisp +++ b/tests/format.pure.lisp @@ -79,4 +79,14 @@ (checked-compile-and-assert () `(lambda () (format nil ,control)) - (() "A" :test #'equal)))) + (() "A" :test #'equal)) + (checked-compile-and-assert + () + `(lambda () (cerror ,control ,control)) + (() (condition 'simple-error))) + (checked-compile-and-assert + () + `(lambda () (error ,control)) + (() (condition 'simple-error))))) + + -- 2.11.4.GIT