From 0481b16cdcd7c2b4c1a877f8a01e569ced99d1ac Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Sun, 13 Mar 2016 21:27:30 +0100
Subject: [PATCH 4/4] Use `ucs-names'.

* lread.c (invalid_character_name, check_scalar_value)
(parse_code_after_prefix, character_name_to_code): New helper
functions that use `ucs-names' and parsing for CJK ideographs.
(read_escape): Use helper functions.
(syms_of_lread): New symbol `ucs-names'.
* test/src/lread-tests.el: New tests; fix a couple of bugs in
existing tests.
---
 src/lread.c             | 122 +++++++++++++++++++++++++++++++-----------------
 test/src/lread-tests.el |  11 ++++-
 2 files changed, 87 insertions(+), 46 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 4000637..567c071 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -44,6 +44,8 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "termhooks.h"
 #include "blockinput.h"
 #include <c-ctype.h>
+#include <string.h>
+#include <stdnoreturn.h>
 
 #ifdef MSDOS
 #include "msdos.h"
@@ -2151,34 +2153,81 @@ grow_read_buffer (void)
 			 MAX_MULTIBYTE_LENGTH, -1, 1);
 }
 
-/* Hash table that maps Unicode character names to code points.  */
-static Lisp_Object character_names;
+/* Signals an `invalid-read-syntax' error indicating that the
+   character name in an \N{...} literal is invalid.  */
+static noreturn void invalid_character_name (Lisp_Object name)
+{
+  xsignal1 (Qinvalid_read_syntax,
+            CALLN (Fformat, build_pure_c_string ("\\N{%s}"), name));
+}
 
-/* Length of the longest Unicode character name, in bytes. */
-static ptrdiff_t max_character_name_length;
+/* Checks that CODE is a valid Unicode scalar value, and returns its
+   value.  CODE should be parsed from the character name given by
+   NAME.  NAME is used for error messages.  */
+static int check_scalar_value (Lisp_Object code, Lisp_Object name)
+{
+  if (! RANGED_INTEGERP (0, code, MAX_UNICODE_CHAR) ||
+      /* Don't allow surrogates.  */
+      RANGED_INTEGERP (0xD800, code, 0xDFFF))
+    invalid_character_name (name);
+  return XINT (code);
+}
 
-/* Initializes `character_names' and `max_character_name_length'.
-   Called by `read_escape'.  */
-void init_character_names (void)
+/* If NAME starts with PREFIX, interpret the rest as a hexadecimal
+   number and return its value.  Raises `invalid-read-syntax' if the
+   number is not a valid scalar value.  Returns -1 if NAME doesn't
+   start with PREFIX.  */
+static int
+parse_code_after_prefix (Lisp_Object name, const char* prefix)
 {
-  character_names = CALLN (Fmake_hash_table,
-                           QCtest, Qequal,
-                           /* Currently around 100,000 Unicode
-                              characters are defined.  */
-                           QCsize, make_natnum (100000));
-  Lisp_Object get_property =
-    Fsymbol_function (intern_c_string ("get-char-code-property"));
-  ptrdiff_t length = 0;
-  for (int i = 0; i <= MAX_UNICODE_CHAR; ++i)
+  ptrdiff_t name_len = SBYTES (name);
+  ptrdiff_t prefix_len = strlen (prefix);
+  /* Allow between one and eight hexadecimal digits after the
+     prefix.  */
+  if (name_len > prefix_len && name_len <= prefix_len + 8
+      && memcmp (SDATA (name), prefix, prefix_len) == 0)
     {
-      Lisp_Object code = make_natnum (i);
-      Lisp_Object name = call2 (get_property, code, Qname);
-      if (NILP (name)) continue;
-      CHECK_STRING (name);
-      length = max (length, SBYTES (name));
-      Fputhash (name, code, character_names);
+      Lisp_Object code = string_to_number (SDATA (name) + prefix_len, 16, false);
+      if (! NILP (code))
+        return check_scalar_value (code, name);
+    }
+  return -1;
+}
+
+/* Returns the scalar value that has the Unicode character name NAME.
+   Raises `invalid-read-syntax' if there is no such character.  */
+static int
+character_name_to_code (Lisp_Object name)
+{
+  /* Code point as U+N, where N is between 1 and 8 hexadecimal
+     digits.  */
+  int code = parse_code_after_prefix (name, "U+");
+  if (code >= 0)
+    return code;
+
+  /* CJK ideographs are not contained in the association list returned
+     by `ucs-names'.  But they follow a predictable naming pattern: a
+     fixed prefix plus the hexadecimal codepoint value.  */
+  code = parse_code_after_prefix (name, "CJK IDEOGRAPH-");
+  if (code >= 0)
+    {
+      /* Various ranges of CJK characters; see UnicodeData.txt.  */
+      if ((code >= 0x3400 && code <= 0x4DB5) ||
+          (code >= 0x4E00 && code <= 0x9FD5) ||
+          (code >= 0x20000 && code <= 0x2A6D6) ||
+          (code >= 0x2A700 && code <= 0x2B734) ||
+          (code >= 0x2B740 && code <= 0x2B81D) ||
+          (code >= 0x2B820 && code <= 0x2CEA1))
+        return code;
+      else
+        invalid_character_name (name);
     }
-  max_character_name_length = length;
+
+  /* Look up the name in the table returned by `ucs-names'.  */
+  Lisp_Object names = call0 (Qucs_names);
+  if (! CONSP (names))
+    invalid_syntax ("Unicode character name database not loaded");
+  return check_scalar_value (CDR (Fassoc (name, names)), name);
 }
 
 /* Read a \-escape sequence, assuming we already read the `\'.
@@ -2394,10 +2443,9 @@ read_escape (Lisp_Object readcharfun, bool stringp)
         c = READCHAR;
         if (c != '{')
           invalid_syntax ("Expected opening brace after \\N");
-        if (NILP (character_names))
-          init_character_names ();
-        USE_SAFE_ALLOCA;
-        char *name = SAFE_ALLOCA (max_character_name_length + 1);
+        /* 200 characters is hopefully long enough.  Increase if
+           not.  */
+        char name[200];
         bool whitespace = false;
         ptrdiff_t length = 0;
         while (true)
@@ -2426,25 +2474,12 @@ read_escape (Lisp_Object readcharfun, bool stringp)
             else
               whitespace = false;
             name[length++] = c;
-            if (length >= max_character_name_length)
+            if (length >= sizeof name)
               invalid_syntax ("Character name too long");
           }
         if (length == 0)
           invalid_syntax ("Empty character name");
-        name[length] = 0;
-        Lisp_Object lisp_name = make_unibyte_string (name, length);
-        Lisp_Object code =
-          (length >= 3 && length <= 10 && name[0] == 'U' && name[1] == '+') ?
-          /* Code point as U+N, where N is between 1 and 8 hexadecimal
-             digits.  */
-          string_to_number (name + 2, 16, false) :
-          Fgethash (lisp_name, character_names, Qnil);
-        SAFE_FREE ();
-        if (! RANGED_INTEGERP (0, code, MAX_UNICODE_CHAR))
-          xsignal1 (Qinvalid_read_syntax,
-                    CALLN (Fformat,
-                           build_pure_c_string ("\\N{%s}"), lisp_name));
-        return XINT (code);
+        return character_name_to_code (make_unibyte_string (name, length));
       }
 
     default:
@@ -4836,6 +4871,5 @@ that are loaded before your customizations are read!  */);
   DEFSYM (Qrehash_size, "rehash-size");
   DEFSYM (Qrehash_threshold, "rehash-threshold");
 
-  character_names = Qnil;
-  staticpro (&character_names);
+  DEFSYM (Qucs_names, "ucs-names");
 }
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 1f87334..ff5d0f6 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -40,10 +40,17 @@
   (should-error (read "?\\N{DOES NOT EXIST}")) :type 'invalid-read-syntax)
 
 (ert-deftest lread-char-non-ascii-name ()
-  (should-error (read "?\\N{LATIN CAPITAL LETTER Ø}")) 'invalid-read-syntax)
+  (should-error (read "?\\N{LATIN CAPITAL LETTER Ø}")
+                :type 'invalid-read-syntax))
 
 (ert-deftest lread-char-empty-name ()
-  (should-error (read "?\\N{}")) 'invalid-read-syntax)
+  (should-error (read "?\\N{}") :type 'invalid-read-syntax))
+
+(ert-deftest lread-char-cjk-name ()
+  (should (equal ?\N{CJK IDEOGRAPH-2B734} #x2B734)))
+
+(ert-deftest lread-char-invalid-cjk-name ()
+  (should-error (read "?\\N{CJK IDEOGRAPH-2B735}") :type 'invalid-read-syntax))
 
 (ert-deftest lread-string-char-number ()
   (should (equal "a\N{U+A817}b" "a\uA817b")))
-- 
2.7.0

