From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Paul Eggert Newsgroups: gmane.emacs.bugs Subject: bug#23660: edebug doesn't support circular object read syntax Date: Sun, 9 Jul 2017 16:30:24 -0700 Organization: UCLA Computer Science Department Message-ID: References: NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------C7CB3D2ECE38C03804A7E6F2" X-Trace: blaine.gmane.org 1499643079 12743 195.159.176.226 (9 Jul 2017 23:31:19 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 9 Jul 2017 23:31:19 +0000 (UTC) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.2.1 To: 23660@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Mon Jul 10 01:31:14 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dULfV-0002zo-NZ for geb-bug-gnu-emacs@m.gmane.org; Mon, 10 Jul 2017 01:31:14 +0200 Original-Received: from localhost ([::1]:37829 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dULfb-00007o-7p for geb-bug-gnu-emacs@m.gmane.org; Sun, 09 Jul 2017 19:31:19 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:52854) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dULfP-00007d-4k for bug-gnu-emacs@gnu.org; Sun, 09 Jul 2017 19:31:10 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dULfK-0001Ey-5I for bug-gnu-emacs@gnu.org; Sun, 09 Jul 2017 19:31:07 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:56615) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dULfJ-0001Es-VK for bug-gnu-emacs@gnu.org; Sun, 09 Jul 2017 19:31:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dULfJ-00085a-Nz for bug-gnu-emacs@gnu.org; Sun, 09 Jul 2017 19:31:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Paul Eggert Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 09 Jul 2017 23:31:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 23660 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch fixed Original-Received: via spool by 23660-submit@debbugs.gnu.org id=B23660.149964303431062 (code B ref 23660); Sun, 09 Jul 2017 23:31:01 +0000 Original-Received: (at 23660) by debbugs.gnu.org; 9 Jul 2017 23:30:34 +0000 Original-Received: from localhost ([127.0.0.1]:59292 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dULer-00084v-DO for submit@debbugs.gnu.org; Sun, 09 Jul 2017 19:30:33 -0400 Original-Received: from zimbra.cs.ucla.edu ([131.179.128.68]:45002) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dULep-00084i-NU for 23660@debbugs.gnu.org; Sun, 09 Jul 2017 19:30:32 -0400 Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 5798C1600D3 for <23660@debbugs.gnu.org>; Sun, 9 Jul 2017 16:30:26 -0700 (PDT) Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10032) with ESMTP id 5LEizRLK6paM for <23660@debbugs.gnu.org>; Sun, 9 Jul 2017 16:30:24 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id C20301600DA for <23660@debbugs.gnu.org>; Sun, 9 Jul 2017 16:30:24 -0700 (PDT) X-Virus-Scanned: amavisd-new at zimbra.cs.ucla.edu Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id 0i9FNGnJvRC0 for <23660@debbugs.gnu.org>; Sun, 9 Jul 2017 16:30:24 -0700 (PDT) Original-Received: from [192.168.1.9] (unknown [47.153.184.153]) by zimbra.cs.ucla.edu (Postfix) with ESMTPSA id 9C9571600D3 for <23660@debbugs.gnu.org>; Sun, 9 Jul 2017 16:30:24 -0700 (PDT) X-Forwarded-Message-Id: In-Reply-To: Content-Language: en-US X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:134381 Archived-At: This is a multi-part message in MIME format. --------------C7CB3D2ECE38C03804A7E6F2 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit While looking into the recent lread.c changes I noticed that the patch for Bug#23660 introduced the possibility of a core dump when substituting in an already-circular data structure. I installed the attached, which I hope is self-explanatory. --------------C7CB3D2ECE38C03804A7E6F2 Content-Type: text/x-patch; name="0001-Fix-core-dump-in-substitute-object-in-subtree.patch" Content-Disposition: attachment; filename="0001-Fix-core-dump-in-substitute-object-in-subtree.patch" Content-Transfer-Encoding: quoted-printable >From 083940a93df17c6e50d6523e30d56ca3d179f688 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 9 Jul 2017 16:04:02 -0700 Subject: [PATCH] Fix core dump in substitute-object-in-subtree MIME-Version: 1.0 Content-Type: text/plain; charset=3DUTF-8 Content-Transfer-Encoding: 8bit Without this fix, (substitute-object-in-subtree #0=3D(#0# 'a) 'a) would dump core, since the C code would recurse indefinitely through the infinite structure. This patch adds an argument to the function, and renames it to lread--substitute-object-in-subtree as the function is not general-purpose and should not be relied on by outside code. See Bug#23660. * src/intervals.c (traverse_intervals_noorder): ARG is now void *, not Lisp_Object, so that callers need not cons unnecessarily. All callers changed. Also, remove related #if-0 code that was =E2=80=9Ctemporary=E2=80=9D in the early 1990s and has not been compilabl= e for some time. * src/lread.c (struct subst): New type, for substitution closure data. (seen_list): Remove this static var, as this info is now part of struct subst. All uses removed. (Flread__substitute_object_in_subtree): Rename from Fsubstitute_object_in_subtree, and give it a 3rd arg so that it doesn=E2=80=99t dump core when called from the top level with an already-cyclic structure. All callers changed. (SUBSTITUTE): Remove. All callers expanded and then simplified. (substitute_object_recurse): Take a single argument SUBST rather than a pair OBJECT and PLACEHOLDER, so that its address can be passed around as part of a closure; this avoids the need for an AUTO_CONS call. All callers changed. If the COMPLETED component is t, treat every subobject as potentially circular. (substitute_in_interval): Take a struct subst * rather than a Lisp_Object, for the closure data. All callers changed. * test/src/lread-tests.el (lread-lread--substitute-object-in-subtree): New test, to check that the core dump does not reoccur. --- lisp/emacs-lisp/edebug.el | 2 +- src/alloc.c | 4 +- src/intervals.c | 66 +--------------------------- src/intervals.h | 3 +- src/lread.c | 110 +++++++++++++++++++---------------------= ------ src/print.c | 6 +-- test/src/lread-tests.el | 6 +++ 7 files changed, 60 insertions(+), 137 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 65e30f8..1494ed1 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -906,7 +906,7 @@ edebug-read-special ;; with the object itself, wherever it occurs. (forward-char 1) (let ((obj (edebug-read-storing-offsets stream))) - (substitute-object-in-subtree obj placeholder) + (lread--substitute-object-in-subtree obj placeholder t= ) (throw 'return (setf (cdr elem) obj))))) ((eq ?# (following-char)) ;; #n# returns a previously read object. diff --git a/src/alloc.c b/src/alloc.c index ac3de83..2d785d5 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1553,7 +1553,7 @@ make_interval (void) /* Mark Lisp objects in interval I. */ =20 static void -mark_interval (register INTERVAL i, Lisp_Object dummy) +mark_interval (INTERVAL i, void *dummy) { /* Intervals should never be shared. So, if extra internal checking i= s enabled, GC aborts if it seems to have visited an interval twice. = */ @@ -1567,7 +1567,7 @@ mark_interval (register INTERVAL i, Lisp_Object dum= my) #define MARK_INTERVAL_TREE(i) \ do { \ if (i && !i->gcmarkbit) \ - traverse_intervals_noorder (i, mark_interval, Qnil); \ + traverse_intervals_noorder (i, mark_interval, NULL); \ } while (0) =20 /*********************************************************************** diff --git a/src/intervals.c b/src/intervals.c index d17d80a..0089ecb 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -224,7 +224,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1) Pass FUNCTION two args: an interval, and ARG. */ =20 void -traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, L= isp_Object), Lisp_Object arg) +traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, v= oid *), + void *arg) { /* Minimize stack usage. */ while (tree) @@ -257,69 +258,6 @@ traverse_intervals (INTERVAL tree, ptrdiff_t positio= n, } } =0C -#if 0 - -static int icount; -static int idepth; -static int zero_length; - -/* These functions are temporary, for debugging purposes only. */ - -INTERVAL search_interval, found_interval; - -void -check_for_interval (INTERVAL i) -{ - if (i =3D=3D search_interval) - { - found_interval =3D i; - icount++; - } -} - -INTERVAL -search_for_interval (INTERVAL i, INTERVAL tree) -{ - icount =3D 0; - search_interval =3D i; - found_interval =3D NULL; - traverse_intervals_noorder (tree, &check_for_interval, Qnil); - return found_interval; -} - -static void -inc_interval_count (INTERVAL i) -{ - icount++; - if (LENGTH (i) =3D=3D 0) - zero_length++; - if (depth > idepth) - idepth =3D depth; -} - -int -count_intervals (INTERVAL i) -{ - icount =3D 0; - idepth =3D 0; - zero_length =3D 0; - traverse_intervals_noorder (i, &inc_interval_count, Qnil); - - return icount; -} - -static INTERVAL -root_interval (INTERVAL interval) -{ - register INTERVAL i =3D interval; - - while (! ROOT_INTERVAL_P (i)) - i =3D INTERVAL_PARENT (i); - - return i; -} -#endif -=0C /* Assuming that a left child exists, perform the following operation: =20 A B diff --git a/src/intervals.h b/src/intervals.h index a0da6f3..9140e0c 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -242,8 +242,7 @@ extern void traverse_intervals (INTERVAL, ptrdiff_t, void (*) (INTERVAL, Lisp_Object), Lisp_Object); extern void traverse_intervals_noorder (INTERVAL, - void (*) (INTERVAL, Lisp_Object)= , - Lisp_Object); + void (*) (INTERVAL, void *), void *); extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t); extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); extern INTERVAL find_interval (INTERVAL, ptrdiff_t); diff --git a/src/lread.c b/src/lread.c index 8e7cd3c..4d1a27d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -595,6 +595,20 @@ read_emacs_mule_char (int c, int (*readbyte) (int, L= isp_Object), Lisp_Object rea } =20 =20 +/* An in-progress substitution of OBJECT for PLACEHOLDER. */ +struct subst +{ + Lisp_Object object; + Lisp_Object placeholder; + + /* Hash table of subobjects of OBJECT that might be circular. If + Qt, all such objects might be circular. */ + Lisp_Object completed; + + /* List of subobjects of OBJECT that have already been visited. */ + Lisp_Object seen; +}; + static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object read0 (Lisp_Object); @@ -603,9 +617,8 @@ static Lisp_Object read1 (Lisp_Object, int *, bool); static Lisp_Object read_list (bool, Lisp_Object); static Lisp_Object read_vector (Lisp_Object, bool); =20 -static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object, - Lisp_Object); -static void substitute_in_interval (INTERVAL, Lisp_Object); +static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Objec= t); +static void substitute_in_interval (INTERVAL, void *); =20 =0C /* Get a character from the tty. */ @@ -3107,7 +3120,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool firs= t_in_list) } else { - Fsubstitute_object_in_subtree (tem, placeholder); + Flread__substitute_object_in_subtree + (tem, placeholder, read_objects_completed); =20 /* ...and #n# will use the real value from now on. */ i =3D hash_lookup (h, number, &hash); @@ -3513,26 +3527,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool fi= rst_in_list) } } =0C - -/* List of nodes we've seen during substitute_object_in_subtree. */ -static Lisp_Object seen_list; - -DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree, - Ssubstitute_object_in_subtree, 2, 2, 0, - doc: /* Replace every reference to PLACEHOLDER in OBJECT with OBJ= ECT. */) - (Lisp_Object object, Lisp_Object placeholder) +DEFUN ("lread--substitute-object-in-subtree", + Flread__substitute_object_in_subtree, + Slread__substitute_object_in_subtree, 3, 3, 0, + doc: /* In OBJECT, replace every occurrence of PLACEHOLDER with O= BJECT. +COMPLETED is a hash table of objects that might be circular, or is t +if any object might be circular. */) + (Lisp_Object object, Lisp_Object placeholder, Lisp_Object completed) { - Lisp_Object check_object; - - /* We haven't seen any objects when we start. */ - seen_list =3D Qnil; - - /* Make all the substitutions. */ - check_object - =3D substitute_object_recurse (object, placeholder, object); - - /* Clear seen_list because we're done with it. */ - seen_list =3D Qnil; + struct subst subst =3D { object, placeholder, completed, Qnil }; + Lisp_Object check_object =3D substitute_object_recurse (&subst, object= ); =20 /* The returned object here is expected to always eq the original. */ @@ -3541,26 +3545,12 @@ DEFUN ("substitute-object-in-subtree", Fsubstitut= e_object_in_subtree, return Qnil; } =20 -/* Feval doesn't get called from here, so no gc protection is needed. = */ -#define SUBSTITUTE(get_val, set_val) \ - do { \ - Lisp_Object old_value =3D get_val; \ - Lisp_Object true_value \ - =3D substitute_object_recurse (object, placeholder, \ - old_value); \ - \ - if (!EQ (old_value, true_value)) \ - { \ - set_val; \ - } \ - } while (0) - static Lisp_Object -substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, = Lisp_Object subtree) +substitute_object_recurse (struct subst *subst, Lisp_Object subtree) { /* If we find the placeholder, return the target object. */ - if (EQ (placeholder, subtree)) - return object; + if (EQ (subst->placeholder, subtree)) + return subst->object; =20 /* For common object types that can't contain other objects, don't bother looking them up; we're done. */ @@ -3570,15 +3560,16 @@ substitute_object_recurse (Lisp_Object object, Li= sp_Object placeholder, Lisp_Obj return subtree; =20 /* If we've been to this node before, don't explore it again. */ - if (!EQ (Qnil, Fmemq (subtree, seen_list))) + if (!EQ (Qnil, Fmemq (subtree, subst->seen))) return subtree; =20 /* If this node can be the entry point to a cycle, remember that we've seen it. It can only be such an entry point if it was made by #n=3D, which means that we can find it as a value in - read_objects_completed. */ - if (hash_lookup (XHASH_TABLE (read_objects_completed), subtree, NULL) = >=3D 0) - seen_list =3D Fcons (subtree, seen_list); + COMPLETED. */ + if (EQ (subst->completed, Qt) + || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >=3D= 0) + subst->seen =3D Fcons (subtree, subst->seen); =20 /* Recurse according to subtree's type. Every branch must return a Lisp_Object. */ @@ -3605,19 +3596,15 @@ substitute_object_recurse (Lisp_Object object, Li= sp_Object placeholder, Lisp_Obj if (SUB_CHAR_TABLE_P (subtree)) i =3D 2; for ( ; i < length; i++) - SUBSTITUTE (AREF (subtree, i), - ASET (subtree, i, true_value)); + ASET (subtree, i, + substitute_object_recurse (subst, AREF (subtree, i))); return subtree; } =20 case Lisp_Cons: - { - SUBSTITUTE (XCAR (subtree), - XSETCAR (subtree, true_value)); - SUBSTITUTE (XCDR (subtree), - XSETCDR (subtree, true_value)); - return subtree; - } + XSETCAR (subtree, substitute_object_recurse (subst, XCAR (subtree)= )); + XSETCDR (subtree, substitute_object_recurse (subst, XCDR (subtree)= )); + return subtree; =20 case Lisp_String: { @@ -3625,11 +3612,8 @@ substitute_object_recurse (Lisp_Object object, Lis= p_Object placeholder, Lisp_Obj substitute_in_interval contains part of the logic. */ =20 INTERVAL root_interval =3D string_intervals (subtree); - AUTO_CONS (arg, object, placeholder); - traverse_intervals_noorder (root_interval, - &substitute_in_interval, arg); - + substitute_in_interval, subst); return subtree; } =20 @@ -3641,12 +3625,10 @@ substitute_object_recurse (Lisp_Object object, Li= sp_Object placeholder, Lisp_Obj =20 /* Helper function for substitute_object_recurse. */ static void -substitute_in_interval (INTERVAL interval, Lisp_Object arg) +substitute_in_interval (INTERVAL interval, void *arg) { - Lisp_Object object =3D Fcar (arg); - Lisp_Object placeholder =3D Fcdr (arg); - - SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value)= ); + set_interval_plist (interval, + substitute_object_recurse (arg, interval->plist)); } =20 =0C @@ -4744,7 +4726,7 @@ syms_of_lread (void) { defsubr (&Sread); defsubr (&Sread_from_string); - defsubr (&Ssubstitute_object_in_subtree); + defsubr (&Slread__substitute_object_in_subtree); defsubr (&Sintern); defsubr (&Sintern_soft); defsubr (&Sunintern); @@ -5057,8 +5039,6 @@ that are loaded before your customizations are read= ! */); read_objects_map =3D Qnil; staticpro (&read_objects_completed); read_objects_completed =3D Qnil; - staticpro (&seen_list); - seen_list =3D Qnil; =20 Vloads_in_progress =3D Qnil; staticpro (&Vloads_in_progress); diff --git a/src/print.c b/src/print.c index 50c75d7..b6ea3ff 100644 --- a/src/print.c +++ b/src/print.c @@ -566,7 +566,7 @@ temp_output_buffer_setup (const char *bufname) =0C static void print (Lisp_Object, Lisp_Object, bool); static void print_preprocess (Lisp_Object); -static void print_preprocess_string (INTERVAL, Lisp_Object); +static void print_preprocess_string (INTERVAL, void *); static void print_object (Lisp_Object, Lisp_Object, bool); =20 DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0, @@ -1214,7 +1214,7 @@ print_preprocess (Lisp_Object obj) case Lisp_String: /* A string may have text properties, which can be circular. */ traverse_intervals_noorder (string_intervals (obj), - print_preprocess_string, Qnil); + print_preprocess_string, NULL); break; =20 case Lisp_Cons: @@ -1263,7 +1263,7 @@ Fills `print-number-table'. */) } =20 static void -print_preprocess_string (INTERVAL interval, Lisp_Object arg) +print_preprocess_string (INTERVAL interval, void *arg) { print_preprocess (interval->plist); } diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 98cbb6a..a0a317f 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -164,4 +164,10 @@ lread-tests--last-message (concat (format-message "Loading `%s': " file-name) "old-style backquotes detected!"))))) =20 +(ert-deftest lread-lread--substitute-object-in-subtree () + (let ((x (cons 0 1))) + (setcar x x) + (lread--substitute-object-in-subtree x 1 t) + (should (eq x (cdr x))))) + ;;; lread-tests.el ends here --=20 2.7.4 --------------C7CB3D2ECE38C03804A7E6F2--