From 2466a71dc3ed7056f6c72decf3ca9f4a39057a7a Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Wed, 7 Jul 2010 13:43:12 +0000
Subject: [PATCH] o When encountering an overlong sequence, a surrogate code,
 or a   too-large codepoint, swallow the whole sequence instead  of putting  
 back the characters like we did previously.  (This new way is in   line with
 how we handle other bad sequences.) o Pass the number of octets read to the
 error handler in these cases. o Update the message strings to include the
 number of octets.

---
 pcl/simple-streams/external-formats/utf-8.lisp | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/pcl/simple-streams/external-formats/utf-8.lisp b/pcl/simple-streams/external-formats/utf-8.lisp
index da348199c..7875d973f 100644
--- a/pcl/simple-streams/external-formats/utf-8.lisp
+++ b/pcl/simple-streams/external-formats/utf-8.lisp
@@ -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.11 2010/07/06 04:46:35 rtoy Exp $")
+(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-8.lisp,v 1.12 2010/07/07 13:43:12 rtoy Exp $")
 
 (in-package "STREAM")
 
@@ -52,17 +52,19 @@
 				 (svref #(127 2047 65535) (1- ,i)))) ; overlong
 			(lisp::surrogatep ,n)) ; surrogate
 		    (progn
-		      (,unput ,i)
+		      ;; Replace the entire sequence with the
+		      ;; replacment character
 		      (values (if ,error
 				  (cond
 				    ((>= ,n lisp:codepoint-limit)
-				     (funcall ,error "Invalid codepoint #x~X" ,n nil))
+				     (funcall ,error "Invalid codepoint #x~X of ~D octets"
+					      ,n (1+ ,i)))
 				    ((lisp::surrogatep ,n)
-				     (funcall ,error "Invalid surrogate code #x~X" ,n nil))
+				     (funcall ,error "Invalid surrogate code #x~X" ,n (1+ ,i)))
 				    (t
-				     (funcall ,error "Overlong utf8 sequence" nil nil)))
+				     (funcall ,error "Overlong utf8 sequence of ~*~D octets" nil (1+ ,i))))
 				  +replacement-character-code+)
-			      1))
+			      (1+ ,i)))
 		    (values ,n (1+ ,i)))))
       (let ((,c ,input))
 	(declare (optimize (ext:inhibit-warnings 3)))
-- 
GitLab