`read': give fuller error message for errors following "#".

This solves bug#70702.

* src/lread.c (READ_AND_BUFFER, INVALID_SYNTAX_WITH_BUFFER):
New macros.
(read0): For errors in characters sequences beginning with "#",
output the entire character sequence rather than just "#".

* test/src/lread-tests.el (lread-test-bug70702): New test.

2 files changed, 51 insertions, 12 deletions

diff --git a/src/lread.c b/src/lread.c
index 7806c3972ee..d0067fb974b 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3969,6 +3969,27 @@ read_stack_reset (intmax_t sp)
   rdstack.sp = sp;
 }
 
+#define READ_AND_BUFFER(c)			\
+  c = READCHAR;					\
+  if (multibyte)				\
+    p += CHAR_STRING (c, (unsigned char *) p);	\
+  else						\
+    *p++ = c;					\
+  if (end - p < MAX_MULTIBYTE_LENGTH + 1)	\
+    {						\
+       offset = p - read_buffer;		\
+       read_buffer = grow_read_buffer (read_buffer, offset, \
+				       &heapbuf, &read_buffer_size, count); \
+       p = read_buffer + offset;					\
+       end = read_buffer + read_buffer_size;				\
+    }
+
+#define INVALID_SYNTAX_WITH_BUFFER()		\
+  {						\
+    *p = 0;					\
+    invalid_syntax (read_buffer, readcharfun);	\
+  }
+
 /* Read a Lisp object.
    If LOCATE_SYMS is true, symbols are read with position.  */
 static Lisp_Object
@@ -3977,6 +3998,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
   char stackbuf[64];
   char *read_buffer = stackbuf;
   ptrdiff_t read_buffer_size = sizeof stackbuf;
+  ptrdiff_t offset;
   char *heapbuf = NULL;
 
   specpdl_ref base_pdl = SPECPDL_INDEX ();
@@ -4078,7 +4100,13 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
     case '#':
       {
-	int ch = READCHAR;
+	char *p = read_buffer;
+	char *end = read_buffer + read_buffer_size;
+
+	*p++ = '#';
+	int ch;
+	READ_AND_BUFFER (ch);
+
 	switch (ch)
 	  {
 	  case '\'':
@@ -4096,11 +4124,11 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 	  case 's':
 	    /* #s(...) -- a record or hash-table */
-	    ch = READCHAR;
+	    READ_AND_BUFFER (ch);
 	    if (ch != '(')
 	      {
 		UNREAD (ch);
-		invalid_syntax ("#s", readcharfun);
+		INVALID_SYNTAX_WITH_BUFFER ();
 	      }
 	    read_stack_push ((struct read_stack_entry) {
 		.type = RE_record,
@@ -4113,7 +4141,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	  case '^':
 	    /* #^[...]  -- char-table
 	       #^^[...] -- sub-char-table */
-	    ch = READCHAR;
+	    READ_AND_BUFFER (ch);
 	    if (ch == '^')
 	      {
 		ch = READCHAR;
@@ -4130,7 +4158,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 		else
 		  {
 		    UNREAD (ch);
-		    invalid_syntax ("#^^", readcharfun);
+		    INVALID_SYNTAX_WITH_BUFFER ();
 		  }
 	      }
 	    else if (ch == '[')
@@ -4146,7 +4174,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	    else
 	      {
 		UNREAD (ch);
-		invalid_syntax ("#^", readcharfun);
+		INVALID_SYNTAX_WITH_BUFFER ();
 	      }
 
 	  case '(':
@@ -4256,12 +4284,12 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 		int c;
 		for (;;)
 		  {
-		    c = READCHAR;
+		    READ_AND_BUFFER (c);
 		    if (c < '0' || c > '9')
 		      break;
 		    if (ckd_mul (&n, n, 10)
 			|| ckd_add (&n, n, c - '0'))
-		      invalid_syntax ("#", readcharfun);
+		      INVALID_SYNTAX_WITH_BUFFER ();
 		  }
 		if (c == 'r' || c == 'R')
 		  {
@@ -4302,18 +4330,18 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 			  = XHASH_TABLE (read_objects_map);
 			ptrdiff_t i = hash_lookup (h, make_fixnum (n));
 			if (i < 0)
-			  invalid_syntax ("#", readcharfun);
+			  INVALID_SYNTAX_WITH_BUFFER ();
 			obj = HASH_VALUE (h, i);
 			break;
 		      }
 		    else
-		      invalid_syntax ("#", readcharfun);
+		      INVALID_SYNTAX_WITH_BUFFER ();
 		  }
 		else
-		  invalid_syntax ("#", readcharfun);
+		  INVALID_SYNTAX_WITH_BUFFER ();
 	      }
 	    else
-	      invalid_syntax ("#", readcharfun);
+	      INVALID_SYNTAX_WITH_BUFFER ();
 	  }
 	break;
       }
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 4d7f8b71838..cc17f7eb3fa 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -174,6 +174,17 @@ literals (Bug#20852)."
     (load "somelib" nil t)
     (should (string-suffix-p "/somelib.el" (caar load-history)))))
 
+(ert-deftest lread-test-bug70702 ()
+  "Test for certain wholesome error messages from `read'."
+  (setq eval-expression-debug-on-error nil)
+  (setq ert-debug-on-error nil)
+  (with-temp-buffer
+    (goto-char (point-min))
+    (insert "#<symbol lambda at 10>")
+    (goto-char (point-min))
+    (should (equal (should-error (read (current-buffer)))
+                   '(invalid-read-syntax "#<" 1 2)))))
+
 (ert-deftest lread-lread--substitute-object-in-subtree ()
   (let ((x (cons 0 1)))
     (setcar x x)