A couple more BASE-CHAR-CODE-LIMIT-related fixes:
... legal format directives are all base-chars;
... define the BASE-CHAR type in terms of the limit constant.
Also add remaining test cases to the test suite, just to get them
out of the way.
(sb!xc:deftype atom () '(not cons))
(sb!xc:deftype atom () '(not cons))
-(sb!xc:deftype base-char () 'character)
+(sb!xc:deftype base-char ()
+ '(character-set ((0 . #.(1- base-char-code-limit)))))
(sb!xc:deftype extended-char ()
#!+sb-doc
(sb!xc:deftype extended-char ()
#!+sb-doc
#-sb-xc-host (code-char tab-char-code)))
(defvar *format-directive-expanders*
#-sb-xc-host (code-char tab-char-code)))
(defvar *format-directive-expanders*
- (make-array char-code-limit :initial-element nil))
+ (make-array base-char-code-limit :initial-element nil))
(defvar *format-directive-interpreters*
(defvar *format-directive-interpreters*
- (make-array char-code-limit :initial-element nil))
+ (make-array base-char-code-limit :initial-element nil))
(defvar *default-format-error-control-string* nil)
(defvar *default-format-error-offset* nil)
(defvar *default-format-error-control-string* nil)
(defvar *default-format-error-offset* nil)
EOF
expect_failed_compile $tmpfilename
EOF
expect_failed_compile $tmpfilename
+# This should be clean
+cat > $tmpfilename <<EOF
+(defvar *string* (make-string 10 :element-type 'base-char))
+EOF
+expect_clean_compile $tmpfilename
+
# This should style-warn (but not warn or otherwise fail) as the call
# to FORMAT has too many arguments, which is bad style but not
# otherwise fatal.
# This should style-warn (but not warn or otherwise fail) as the call
# to FORMAT has too many arguments, which is bad style but not
# otherwise fatal.
;;; KLUDGE: not all in one big form because that causes SBCL to spend
;;; an absolute age trying to compile it.
(defmacro sequence-bounding-indices-test (&body body)
;;; KLUDGE: not all in one big form because that causes SBCL to spend
;;; an absolute age trying to compile it.
(defmacro sequence-bounding-indices-test (&body body)
;; See Issues 332 [and 333(!)] in the CLHS
(declare (optimize (safety 3)))
(let ((string (make-array 10
:fill-pointer 5
:initial-element #\a
:element-type 'base-char)))
;; See Issues 332 [and 333(!)] in the CLHS
(declare (optimize (safety 3)))
(let ((string (make-array 10
:fill-pointer 5
:initial-element #\a
:element-type 'base-char)))
+ ,(car body)
+ (format t "... BASE-CHAR")
+ (finish-output)
+ (flet ((reset ()
+ (setf (fill-pointer string) 10)
+ (fill string #\a)
+ (setf (fill-pointer string) 5)))
+ (declare (ignorable #'reset))
+ ,@(cdr body))))
+ (locally
+ ;; See Issues 332 [and 333(!)] in the CLHS
+ (declare (optimize (safety 3)))
+ (let ((string (make-array 10
+ :fill-pointer 5
+ :initial-element #\a
+ :element-type 'character)))
+ ,(car body)
+ (format t "... CHARACTER")
+ (finish-output)
(flet ((reset ()
(setf (fill-pointer string) 10)
(fill string #\a)
(setf (fill-pointer string) 5)))
(declare (ignorable #'reset))
(flet ((reset ()
(setf (fill-pointer string) 10)
(fill string #\a)
(setf (fill-pointer string) 5)))
(declare (ignorable #'reset))
(declaim (notinline opaque-identity))
(defun opaque-identity (x) x)
;;; Accessor SUBSEQ
(sequence-bounding-indices-test
(declaim (notinline opaque-identity))
(defun opaque-identity (x) x)
;;; Accessor SUBSEQ
(sequence-bounding-indices-test
- (format t "~&/Accessor SUBSEQ~%")
+ (format t "~&/Accessor SUBSEQ")
(assert (string= (subseq string 0 5) "aaaaa"))
(assert (raises-error? (subseq string 0 6)))
(assert (raises-error? (subseq string (opaque-identity -1) 5)))
(assert (string= (subseq string 0 5) "aaaaa"))
(assert (raises-error? (subseq string 0 6)))
(assert (raises-error? (subseq string (opaque-identity -1) 5)))
;;; 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".)
;;; 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".)