From: Alan Mackenzie Date: Mon, 6 May 2024 20:14:57 +0000 (+0000) Subject: `read': give fuller error message for errors following "#". X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=248029a8c786fe11397794010c25f8448746f58d;p=emacs.git `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. (cherry picked from commit 67e1b9d0553238ec6a5af68b41f43ba157f529e1) --- 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 "#") + (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)