CMUCL commit: src/pcl/simple-streams/external-formats (8 files)
Raymond Toy
rtoy at common-lisp.net
Mon Jul 5 06:12:47 CEST 2010
Date: Monday, July 5, 2010 @ 00:12:47
Author: rtoy
Path: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats
Modified: ascii.lisp utf-16-be.lisp utf-16-le.lisp utf-16.lisp utf-32-be.lisp
utf-32-le.lisp utf-32.lisp utf-8.lisp
Oops. It's ~4,'0X, not ~4,0X.
For utf-8, also print out the value of the invalid codepoint.
----------------+
ascii.lisp | 4 ++--
utf-16-be.lisp | 8 ++++----
utf-16-le.lisp | 8 ++++----
utf-16.lisp | 8 ++++----
utf-32-be.lisp | 8 ++++----
utf-32-le.lisp | 8 ++++----
utf-32.lisp | 8 ++++----
utf-8.lisp | 6 +++---
8 files changed, 29 insertions(+), 29 deletions(-)
Index: src/pcl/simple-streams/external-formats/ascii.lisp
diff -u src/pcl/simple-streams/external-formats/ascii.lisp:1.2 src/pcl/simple-streams/external-formats/ascii.lisp:1.3
--- src/pcl/simple-streams/external-formats/ascii.lisp:1.2 Fri Jul 2 19:13:11 2010
+++ src/pcl/simple-streams/external-formats/ascii.lisp Mon Jul 5 00:12:47 2010
@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy and has been placed in the public
;;; domain.
;;;
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/ascii.lisp,v 1.2 2010-07-02 23:13:11 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/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)
Index: src/pcl/simple-streams/external-formats/utf-16-be.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.7 src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.8
--- src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.7 Sat Jul 3 09:45:01 2010
+++ src/pcl/simple-streams/external-formats/utf-16-be.lisp Mon Jul 5 00:12:47 2010
@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public
;;; domain.
;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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)))))
Index: src/pcl/simple-streams/external-formats/utf-16-le.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.7 src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.8
--- src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.7 Sat Jul 3 09:45:01 2010
+++ src/pcl/simple-streams/external-formats/utf-16-le.lisp Mon Jul 5 00:12:47 2010
@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public
;;; domain.
;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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)))))
Index: src/pcl/simple-streams/external-formats/utf-16.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16.lisp:1.9 src/pcl/simple-streams/external-formats/utf-16.lisp:1.10
--- src/pcl/simple-streams/external-formats/utf-16.lisp:1.9 Sat Jul 3 09:45:01 2010
+++ src/pcl/simple-streams/external-formats/utf-16.lisp Mon Jul 5 00:12:47 2010
@@ -1,7 +1,7 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*-
;;;
;;; **********************************************************************
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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)))))
Index: src/pcl/simple-streams/external-formats/utf-32-be.lisp
diff -u src/pcl/simple-streams/external-formats/utf-32-be.lisp:1.6 src/pcl/simple-streams/external-formats/utf-32-be.lisp:1.7
--- src/pcl/simple-streams/external-formats/utf-32-be.lisp:1.6 Sat Jul 3 09:42:52 2010
+++ src/pcl/simple-streams/external-formats/utf-32-be.lisp Mon Jul 5 00:12:47 2010
@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy and has been placed in the public
;;; domain.
;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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
Index: src/pcl/simple-streams/external-formats/utf-32-le.lisp
diff -u src/pcl/simple-streams/external-formats/utf-32-le.lisp:1.6 src/pcl/simple-streams/external-formats/utf-32-le.lisp:1.7
--- src/pcl/simple-streams/external-formats/utf-32-le.lisp:1.6 Sat Jul 3 09:42:52 2010
+++ src/pcl/simple-streams/external-formats/utf-32-le.lisp Mon Jul 5 00:12:47 2010
@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy and has been placed in the public
;;; domain.
;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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
Index: src/pcl/simple-streams/external-formats/utf-32.lisp
diff -u src/pcl/simple-streams/external-formats/utf-32.lisp:1.8 src/pcl/simple-streams/external-formats/utf-32.lisp:1.9
--- src/pcl/simple-streams/external-formats/utf-32.lisp:1.8 Sat Jul 3 09:42:52 2010
+++ src/pcl/simple-streams/external-formats/utf-32.lisp Mon Jul 5 00:12:47 2010
@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy and has been placed in the public
;;; domain.
;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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
Index: src/pcl/simple-streams/external-formats/utf-8.lisp
diff -u src/pcl/simple-streams/external-formats/utf-8.lisp:1.9 src/pcl/simple-streams/external-formats/utf-8.lisp:1.10
--- src/pcl/simple-streams/external-formats/utf-8.lisp:1.9 Fri Jul 2 19:13:12 2010
+++ src/pcl/simple-streams/external-formats/utf-8.lisp Mon Jul 5 00:12:47 2010
@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public
;;; domain.
;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/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+)
More information about the cmucl-commit
mailing list