Skip to content
Snippets Groups Projects
Commit 5c8abc68 authored by rtoy's avatar rtoy
Browse files

Oops. It's ~4,'0X, not ~4,0X.

For utf-8, also print out the value of the invalid codepoint.
parent b92592e0
No related branches found
No related tags found
No related merge requests found
......@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy and has been placed in the public
;;; domain.
;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/ascii.lisp,v 1.2 2010/07/02 23:13:11 rtoy Exp $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/ascii.lisp,v 1.3 2010/07/05 04:12:47 rtoy Exp $")
(in-package "STREAM")
......@@ -15,7 +15,7 @@
(values (if (< ,c #x80)
,c
(if ,error
(funcall ,error "Invalid octet #x~4,0X for ASCII" ,c 1)
(funcall ,error "Invalid octet #x~4,'0X for ASCII" ,c 1)
+replacement-character-code+))
1))
(code-to-octets (code state output error)
......
......@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public
;;; domain.
;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.7 2010/07/03 13:45:01 rtoy Exp $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.8 2010/07/05 04:12:47 rtoy Exp $")
(in-package "STREAM")
......@@ -28,7 +28,7 @@
,state nil)
(setf ,code
(if ,error
(funcall ,error "Bare low surrogate #x~4,0X" ,code 2)
(funcall ,error "Bare low surrogate #x~4,'0X" ,code 2)
+replacement-character-code+))))
((lisp::surrogatep ,code :high)
;; Remember the high surrogate in case we bail out
......@@ -47,7 +47,7 @@
(setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400))
(setf ,code
(if ,error
(funcall ,error "High surrogate followed by #x~4,0X instead of low surrogate" ,next ,wd)
(funcall ,error "High surrogate followed by #x~4,'0X instead of low surrogate" ,next ,wd)
+replacement-character-code+)))))
((= ,code #xFFFE)
;; Replace with REPLACEMENT CHARACTER.
......@@ -79,7 +79,7 @@
(,output (if (lisp::surrogatep ,c)
(if ,error
(funcall ,error
"Flushing bare surrogate #x~4,0X is illegal for UTF-16"
"Flushing bare surrogate #x~4,'0X is illegal for UTF-16"
(char-code ,c))
+replacement-character-code+)
,c)))))
......
......@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public
;;; domain.
;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.7 2010/07/03 13:45:01 rtoy Exp $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.8 2010/07/05 04:12:47 rtoy Exp $")
(in-package "STREAM")
......@@ -30,7 +30,7 @@
,state nil)
(setf ,code
(if ,error
(funcall ,error "Bare low surrogate #x~4,0X" ,code 2)
(funcall ,error "Bare low surrogate #x~4,'0X" ,code 2)
+replacement-character-code+))))
((lisp::surrogatep ,code :high)
;; Remember the high surrogate in case we bail out
......@@ -48,7 +48,7 @@
(setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400))
(setq ,code
(if ,error
(funcall ,error "High surrogate followed by #x~4,0X instead of low surrogate" ,next 2)
(funcall ,error "High surrogate followed by #x~4,'0X instead of low surrogate" ,next 2)
+replacement-character-code+)))))
((= ,code #xFFFE)
;; replace with REPLACEMENT CHARACTER.
......@@ -80,7 +80,7 @@
(,output (if (lisp::surrogatep ,c)
(if ,error
(funcall ,error
"Flushing bare surrogate #x~4,0X is illegal for UTF-16"
"Flushing bare surrogate #x~4,'0X is illegal for UTF-16"
(char-code ,c))
+replacement-character-code+)
,c)))))
......
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*-
;;;
;;; **********************************************************************
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.9 2010/07/03 13:45:01 rtoy Exp $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.10 2010/07/05 04:12:47 rtoy Exp $")
(in-package "STREAM")
......@@ -57,7 +57,7 @@
,state nil)
(setf ,code
(if ,error
(funcall ,error "Bare low surrogate #x~4,0X" ,code 2)
(funcall ,error "Bare low surrogate #x~4,'0X" ,code 2)
+replacement-character-code+))))
((lisp::surrogatep ,code :high)
;; Save the high (leading) code in the state, in
......@@ -81,7 +81,7 @@
,wd 4)
(setf ,code
(if ,error
(funcall ,error "High surrogate followed by #x~4,0X instead of low surrogate" ,next ,wd)
(funcall ,error "High surrogate followed by #x~4,'0X instead of low surrogate" ,next ,wd)
+replacement-character-code+)))))
((and (= ,code #xFFFE) (zerop ,st))
(setf (car ,state) 1) (go :again))
......@@ -120,7 +120,7 @@
(out (if (lisp::surrogatep ,c)
(if ,error
(funcall ,error
"Flushing bare surrogate #x~4,0X is illegal for UTF-16"
"Flushing bare surrogate #x~4,'0X is illegal for UTF-16"
(char-code ,c))
+replacement-character-code+)
,c)))))
......
......@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy and has been placed in the public
;;; domain.
;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.6 2010/07/03 13:42:52 rtoy Exp $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.7 2010/07/05 04:12:47 rtoy Exp $")
(in-package "STREAM")
......@@ -27,8 +27,8 @@
;; Surrogates are illegal. Use replacement character.
(values (if ,error
(if (>= ,code lisp:codepoint-limit)
(funcall ,error "Illegal codepoint #x~4,0X" ,code 4)
(funcall ,error "Surrogate #x~4,0X not allowed in UTF32" ,code 4))
(funcall ,error "Illegal codepoint #x~4,'0X" ,code 4)
(funcall ,error "Surrogate #x~4,'0X not allowed in UTF32" ,code 4))
+replacement-character-code+)
4))
(t
......@@ -46,7 +46,7 @@
(setf ,state t))
(cond ((lisp::surrogatep ,code)
(out (if ,error
(funcall ,error "Surrogate code #x~4,0X is illegal for UTF32 output"
(funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output"
,code)
+replacement-character-code+)))
(t
......
......@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy and has been placed in the public
;;; domain.
;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.6 2010/07/03 13:42:52 rtoy Exp $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.7 2010/07/05 04:12:47 rtoy Exp $")
(in-package "STREAM")
......@@ -27,8 +27,8 @@
;; Surrogates are illegal. Use replacement character.
(values (if ,error
(if (>= ,code lisp:codepoint-limit)
(funcall ,error "Illegal codepoint #x~4,0X" ,code 4)
(funcall ,error "Surrogate #x~4,0X not allowed in UTF32"
(funcall ,error "Illegal codepoint #x~4,'0X" ,code 4)
(funcall ,error "Surrogate #x~4,'0X not allowed in UTF32"
,code 4))
+replacement-character-code+)
4))
......@@ -43,7 +43,7 @@
(,output (ldb (byte 8 (* 8 ,i)) ,c)))))
(cond ((lisp::surrogatep ,code)
(out (if ,error
(funcall ,error "Surrogate code #x~4,0X is illegal for UTF32 output"
(funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output"
,code)
+replacement-character-code+)))
(t
......
......@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy and has been placed in the public
;;; domain.
;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.8 2010/07/03 13:42:52 rtoy Exp $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.9 2010/07/05 04:12:47 rtoy Exp $")
(in-package "STREAM")
......@@ -62,8 +62,8 @@
(setf ,code
(if ,error
(if (>= ,code lisp:codepoint-limit)
(funcall ,error "Illegal codepoint #x~4,0X" ,code 4)
(funcall ,error "Surrogate #x~4,0X not allowed in UTF32"
(funcall ,error "Illegal codepoint #x~4,'0X" ,code 4)
(funcall ,error "Surrogate #x~4,'0X not allowed in UTF32"
,code 4))
+replacement-character-code+)))
((and (zerop ,st) (= ,code #xFFFE0000))
......@@ -88,7 +88,7 @@
(setf ,state t))
(cond ((lisp::surrogatep ,code)
(out (if ,error
(funcall ,error "Surrogate code #x~4,0X is illegal for UTF32 output"
(funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output"
,code)
+replacement-character-code+)))
(t
......
......@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public
;;; domain.
;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-8.lisp,v 1.9 2010/07/02 23:13:12 rtoy Exp $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-8.lisp,v 1.10 2010/07/05 04:12:47 rtoy Exp $")
(in-package "STREAM")
......@@ -56,9 +56,9 @@
(values (if ,error
(cond
((>= ,n lisp:codepoint-limit)
(funcall ,error "Invalid codepoint" nil nil))
(funcall ,error "Invalid codepoint #x~X" ,n nil))
((lisp::surrogatep ,n)
(funcall ,error "Invalid surrogate code #x~4,0X" ,n nil))
(funcall ,error "Invalid surrogate code #x~X" ,n nil))
(t
(funcall ,error "Overlong utf8 sequence" nil nil)))
+replacement-character-code+)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment