From c688af8f42d54d5d313cb890c2dad73cb60f5551 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Mon, 20 Sep 2010 23:01:15 +0000
Subject: [PATCH] o Inhibit warnings from SURROGATEP; I'm tired seeing the code
 deletion   notes now. o Tell the compiler what type the first return value of
 CODEPOINT is.   Apparently, the compiler can't figure that out itself.

---
 code/string.lisp | 18 +++++++++++-------
 1 file changed, 11 insertions(+), 7 deletions(-)

diff --git a/code/string.lisp b/code/string.lisp
index cbea623ec..f84ae5a89 100644
--- a/code/string.lisp
+++ b/code/string.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.26 2010/09/15 21:06:38 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.27 2010/09/20 23:01:15 rtoy Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -40,7 +40,9 @@
   for.  :High means to test for the high (leading) surrogate; :Low
   tests for the low (trailing surrogate).  A value of :Any or Nil
   tests for any surrogate value (high or low)."
-  (declare (type (or character codepoint) char-or-code))
+  (declare (type (or character codepoint) char-or-code)
+	   (type (or null (member :high :leading :low :trailing :any)) surrogate-type)
+	   (optimize (inhibit-warnings 3)))
   (let ((code (if (characterp char-or-code)
 		  (char-code char-or-code)
 		  char-or-code)))
@@ -74,14 +76,16 @@
     (cond ((and (surrogatep code :high) (< (1+ i) end))
 	   (let ((tmp (char-code (schar string (1+ i)))))
 	     (if (surrogatep tmp :low)
-		 (values (+ (ash (- code #xD800) 10) tmp #x2400) +1)
-		 (values code nil))))
+		 (values (truly-the codepoint (+ (ash (- code #xD800) 10) tmp #x2400))
+			 +1)
+		 (values (truly-the codepoint code) nil))))
 	  ((and (surrogatep code :low) (> i 0))
 	   (let ((tmp (char-code (schar string (1- i)))))
 	     (if (surrogatep tmp :high)
-		 (values (+ (ash (- tmp #xD800) 10) code #x2400) -1)
-		 (values code nil))))
-	  (t (values code nil)))))
+		 (values (truly-the codepoint (+ (ash (- tmp #xD800) 10) code #x2400))
+			 -1)
+		 (values (truly-the codepoint code) nil))))
+	  (t (values (truly-the codepoint code) nil)))))
 
 (defun surrogates (codepoint)
   "Return the high and low surrogate characters for Codepoint.  If
-- 
GitLab