* bug#23660: edebug doesn't support circular object read syntax
@ 2016-05-31 2:29 Noam Postavsky
2016-05-31 14:53 ` Michael Heerdegen
0 siblings, 1 reply; 7+ messages in thread
From: Noam Postavsky @ 2016-05-31 2:29 UTC (permalink / raw)
To: 23660
Do C-u C-M-x on
'(#1=a . #1#)
Result: Invalid read syntax "#"
It would be useful to support this in order to instrument
macroexpanded code that uses `make-symbol'.
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#23660: edebug doesn't support circular object read syntax
2016-05-31 2:29 bug#23660: edebug doesn't support circular object read syntax Noam Postavsky
@ 2016-05-31 14:53 ` Michael Heerdegen
2016-05-31 15:13 ` Noam Postavsky
0 siblings, 1 reply; 7+ messages in thread
From: Michael Heerdegen @ 2016-05-31 14:53 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 23660
Noam Postavsky <npostavs@users.sourceforge.net> writes:
> Do C-u C-M-x on
>
> '(#1=a . #1#)
>
> Result: Invalid read syntax "#"
Instrumenting a constant is surely not very useful. But instrumenting a
definition that contains that read syntax fails too; e.g.
(defun f ()
'(#1=a . #1#))
which is not so nice indeed (the above definition doesn't involve
anything circular btw).
Michael.
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#23660: edebug doesn't support circular object read syntax
2016-05-31 14:53 ` Michael Heerdegen
@ 2016-05-31 15:13 ` Noam Postavsky
2017-02-20 18:33 ` bug#23660: Patch (was: bug#23660: edebug doesn't support circular object read syntax) Gemini Lasswell
0 siblings, 1 reply; 7+ messages in thread
From: Noam Postavsky @ 2016-05-31 15:13 UTC (permalink / raw)
To: 23660
On Tue, May 31, 2016 at 10:53 AM, Michael Heerdegen
<michael_heerdegen@web.de> wrote:
> (the above definition doesn't involve anything circular btw).
Yes, this particular object is not circular, it's just a minimal
example of what the manual describes in the "Read Syntax for Circular
Objects" section. And `print-circle' needs to be set to non-nil in
order to get such output when printing (e.g. macro-expansions).
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#23660: Patch (was: bug#23660: edebug doesn't support circular object read syntax)
2016-05-31 15:13 ` Noam Postavsky
@ 2017-02-20 18:33 ` Gemini Lasswell
2017-02-20 19:39 ` bug#23660: Patch for (edebug " npostavs
0 siblings, 1 reply; 7+ messages in thread
From: Gemini Lasswell @ 2017-02-20 18:33 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 23660
[-- Attachment #1: Type: text/plain, Size: 74 bytes --]
Here's a patch adding support for circular object read syntax to Edebug:
[-- Attachment #2: 0001-Support-read-syntax-for-circular-objects-in-Edebug-B.patch --]
[-- Type: text/plain, Size: 6361 bytes --]
From 5c3a56e4723960cdc335d6daec3387f8114e3cb0 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Thu, 16 Feb 2017 22:08:03 -0800
Subject: [PATCH] Support read syntax for circular objects in Edebug
(Bug#23660)
* lisp/emacs-lisp/edebug.el (edebug-read-special): New name
for edebug-read-function. Handle the read syntax for circular
objects.
(edebug-read-objects): New variable.
(edebug-read-and-maybe-wrap-form1): Reset edebug-read-objects.
* src/lread.c (Fsubstitute_object_in_subtree): Make
substitute_object_in_subtree into a Lisp primitive.
---
lisp/emacs-lisp/edebug.el | 60 +++++++++++++++++++++++++++++++++++++----------
src/lread.c | 12 ++++++----
2 files changed, 55 insertions(+), 17 deletions(-)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index a883804..267fc57 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -755,6 +755,11 @@ edebug-offsets
(defvar edebug-offsets-stack nil)
(defvar edebug-current-offset nil) ; Top of the stack, for convenience.
+;; The association list of objects read with the #n=object form.
+;; Each member of the list has the form (n . object), and is used to
+;; look up the object for the corresponding #n# construct.
+(defvar edebug-read-objects nil)
+
;; We must store whether we just read a list with a dotted form that
;; is itself a list. This structure will be condensed, so the offsets
;; must also be condensed.
@@ -826,7 +831,7 @@ edebug-read-alist
(backquote . edebug-read-backquote)
(comma . edebug-read-comma)
(lbracket . edebug-read-vector)
- (hash . edebug-read-function)
+ (hash . edebug-read-special)
))
(defun edebug-read-storing-offsets (stream)
@@ -872,17 +877,47 @@ edebug-read-comma
(edebug-storing-offsets opoint symbol)
(edebug-read-storing-offsets stream)))))
-(defun edebug-read-function (stream)
- ;; Turn #'thing into (function thing)
- (forward-char 1)
- (cond ((eq ?\' (following-char))
- (forward-char 1)
- (list
- (edebug-storing-offsets (- (point) 2) 'function)
- (edebug-read-storing-offsets stream)))
- (t
- (backward-char 1)
- (read stream))))
+(defun edebug-read-special (stream)
+ "Read from STREAM a Lisp object beginning with #.
+Turn #'thing into (function thing) and handle the read syntax for
+circular objects. Let `read' read everything else."
+ (catch 'return
+ (forward-char 1)
+ (let ((start (point)))
+ (cond
+ ((eq ?\' (following-char))
+ (forward-char 1)
+ (throw 'return
+ (list
+ (edebug-storing-offsets (- (point) 2) 'function)
+ (edebug-read-storing-offsets stream))))
+ ((and (>= (following-char) ?0) (<= (following-char) ?9))
+ (while (and (>= (following-char) ?0) (<= (following-char) ?9))
+ (forward-char 1))
+ (let ((n (string-to-number (buffer-substring start (point)))))
+ (when (and read-circle
+ (<= n most-positive-fixnum))
+ (cond
+ ((eq ?= (following-char))
+ ;; Make a placeholder for #n# to use temporarily.
+ (let* ((placeholder (cons nil nil))
+ (elem (cons n placeholder)))
+ (push elem edebug-read-objects)
+ ;; Read the object and then replace the placeholder
+ ;; with the object itself, wherever it occurs.
+ (forward-char 1)
+ (let ((obj (edebug-read-storing-offsets stream)))
+ (substitute-object-in-subtree obj placeholder)
+ (throw 'return (setf (cdr elem) obj)))))
+ ((eq ?# (following-char))
+ ;; #n# returns a previously read object.
+ (let ((elem (assq n edebug-read-objects)))
+ (when (consp elem)
+ (forward-char 1)
+ (throw 'return (cdr elem))))))))))
+ ;; Let read handle errors, radix notation, and anything else.
+ (goto-char (1- start))
+ (read stream))))
(defun edebug-read-list (stream)
(forward-char 1) ; skip \(
@@ -1074,6 +1109,7 @@ edebug-read-and-maybe-wrap-form1
edebug-offsets
edebug-offsets-stack
edebug-current-offset ; reset to nil
+ edebug-read-objects
)
(save-excursion
(if (and (eq 'lparen (edebug-next-token-class))
diff --git a/src/lread.c b/src/lread.c
index 094aa62..1b154b7 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -558,8 +558,6 @@ static Lisp_Object read_vector (Lisp_Object, bool);
static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
Lisp_Object);
-static void substitute_object_in_subtree (Lisp_Object,
- Lisp_Object);
static void substitute_in_interval (INTERVAL, Lisp_Object);
\f
@@ -2957,7 +2955,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
tem = read0 (readcharfun);
/* Now put it everywhere the placeholder was... */
- substitute_object_in_subtree (tem, placeholder);
+ Fsubstitute_object_in_subtree (tem, placeholder);
/* ...and #n# will use the real value from now on. */
Fsetcdr (cell, tem);
@@ -3326,8 +3324,10 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
/* List of nodes we've seen during substitute_object_in_subtree. */
static Lisp_Object seen_list;
-static void
-substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
+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 OBJECT. */)
+ (Lisp_Object object, Lisp_Object placeholder)
{
Lisp_Object check_object;
@@ -3345,6 +3345,7 @@ substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
original. */
if (!EQ (check_object, object))
error ("Unexpected mutation error in reader");
+ return Qnil;
}
/* Feval doesn't get called from here, so no gc protection is needed. */
@@ -4548,6 +4549,7 @@ syms_of_lread (void)
{
defsubr (&Sread);
defsubr (&Sread_from_string);
+ defsubr (&Ssubstitute_object_in_subtree);
defsubr (&Sintern);
defsubr (&Sintern_soft);
defsubr (&Sunintern);
--
2.10.1
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#23660: Patch for (edebug doesn't support circular object read syntax)
2017-02-20 18:33 ` bug#23660: Patch (was: bug#23660: edebug doesn't support circular object read syntax) Gemini Lasswell
@ 2017-02-20 19:39 ` npostavs
2017-02-24 1:29 ` npostavs
0 siblings, 1 reply; 7+ messages in thread
From: npostavs @ 2017-02-20 19:39 UTC (permalink / raw)
To: Gemini Lasswell; +Cc: 23660
tags 23660 patch
quit
Gemini Lasswell <gazally@runbox.com> writes:
> Here's a patch adding support for circular object read syntax to Edebug:
Looks good, I will push to master in a few days.
The main motivation (which I probably should have mentioned in the OP)
is to step in macro expansions, e.g. after doing (setq print-circle t
print-gensym t)
(pcase '(1 2)
(`(,a ,b) (+ a b)))
expands to
(if (consp #1='(1 2))
(let* ((#5=#:x (car #1#))
(#2=#:x (cdr #1#)))
(if (consp #2#)
(let* ((#4=#:x (car #2#))
(#3=#:x (cdr #2#)))
(if (null #3#)
(let ((b #4#)
(a #5#))
(+ a b))
nil))
nil))
nil)
With the patch, I can step through the latter nicely. Thanks!
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#23660: Patch for (edebug doesn't support circular object read syntax)
2017-02-20 19:39 ` bug#23660: Patch for (edebug " npostavs
@ 2017-02-24 1:29 ` npostavs
0 siblings, 0 replies; 7+ messages in thread
From: npostavs @ 2017-02-24 1:29 UTC (permalink / raw)
To: Gemini Lasswell; +Cc: 23660
tags 23660 fixed
close 23660 26.1
quit
npostavs@users.sourceforge.net writes:
>
> Gemini Lasswell <gazally@runbox.com> writes:
>
>> Here's a patch adding support for circular object read syntax to Edebug:
>
> Looks good, I will push to master in a few days.
Pushed.
1: 2017-02-23 20:21:11 -0500 8b912ab47bc91f54565f127abf24c97e5d46a1ba
Support read syntax for circular objects in Edebug (Bug#23660)
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#23660: edebug doesn't support circular object read syntax
[not found] <a1a0386b-0307-3c16-08ab-64bcaee1f1c5@cs.ucla.edu>
@ 2017-07-09 23:30 ` Paul Eggert
0 siblings, 0 replies; 7+ messages in thread
From: Paul Eggert @ 2017-07-09 23:30 UTC (permalink / raw)
To: 23660
[-- Attachment #1: Type: text/plain, Size: 248 bytes --]
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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-core-dump-in-substitute-object-in-subtree.patch --]
[-- Type: text/x-patch; name="0001-Fix-core-dump-in-substitute-object-in-subtree.patch", Size: 15747 bytes --]
From 083940a93df17c6e50d6523e30d56ca3d179f688 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
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=UTF-8
Content-Transfer-Encoding: 8bit
Without this fix, (substitute-object-in-subtree #0=(#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
“temporary” in the early 1990s and has not been compilable 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’t 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. */
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 is
enabled, GC aborts if it seems to have visited an interval twice. */
@@ -1567,7 +1567,7 @@ mark_interval (register INTERVAL i, Lisp_Object dummy)
#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)
/***********************************************************************
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. */
void
-traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
+traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *),
+ void *arg)
{
/* Minimize stack usage. */
while (tree)
@@ -257,69 +258,6 @@ traverse_intervals (INTERVAL tree, ptrdiff_t position,
}
}
\f
-#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 == search_interval)
- {
- found_interval = i;
- icount++;
- }
-}
-
-INTERVAL
-search_for_interval (INTERVAL i, INTERVAL tree)
-{
- icount = 0;
- search_interval = i;
- found_interval = NULL;
- traverse_intervals_noorder (tree, &check_for_interval, Qnil);
- return found_interval;
-}
-
-static void
-inc_interval_count (INTERVAL i)
-{
- icount++;
- if (LENGTH (i) == 0)
- zero_length++;
- if (depth > idepth)
- idepth = depth;
-}
-
-int
-count_intervals (INTERVAL i)
-{
- icount = 0;
- idepth = 0;
- zero_length = 0;
- traverse_intervals_noorder (i, &inc_interval_count, Qnil);
-
- return icount;
-}
-
-static INTERVAL
-root_interval (INTERVAL interval)
-{
- register INTERVAL i = interval;
-
- while (! ROOT_INTERVAL_P (i))
- i = INTERVAL_PARENT (i);
-
- return i;
-}
-#endif
-\f
/* Assuming that a left child exists, perform the following operation:
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, Lisp_Object), Lisp_Object rea
}
+/* 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);
-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_Object);
+static void substitute_in_interval (INTERVAL, void *);
\f
/* Get a character from the tty. */
@@ -3107,7 +3120,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
}
else
{
- Fsubstitute_object_in_subtree (tem, placeholder);
+ Flread__substitute_object_in_subtree
+ (tem, placeholder, read_objects_completed);
/* ...and #n# will use the real value from now on. */
i = hash_lookup (h, number, &hash);
@@ -3513,26 +3527,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
}
}
\f
-
-/* 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 OBJECT. */)
- (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 OBJECT.
+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 = Qnil;
-
- /* Make all the substitutions. */
- check_object
- = substitute_object_recurse (object, placeholder, object);
-
- /* Clear seen_list because we're done with it. */
- seen_list = Qnil;
+ struct subst subst = { object, placeholder, completed, Qnil };
+ Lisp_Object check_object = substitute_object_recurse (&subst, object);
/* The returned object here is expected to always eq the
original. */
@@ -3541,26 +3545,12 @@ DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree,
return Qnil;
}
-/* Feval doesn't get called from here, so no gc protection is needed. */
-#define SUBSTITUTE(get_val, set_val) \
- do { \
- Lisp_Object old_value = get_val; \
- Lisp_Object true_value \
- = 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;
/* 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, Lisp_Object placeholder, Lisp_Obj
return subtree;
/* 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;
/* 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=, which means that we can find it as a value in
- read_objects_completed. */
- if (hash_lookup (XHASH_TABLE (read_objects_completed), subtree, NULL) >= 0)
- seen_list = Fcons (subtree, seen_list);
+ COMPLETED. */
+ if (EQ (subst->completed, Qt)
+ || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0)
+ subst->seen = Fcons (subtree, subst->seen);
/* Recurse according to subtree's type.
Every branch must return a Lisp_Object. */
@@ -3605,19 +3596,15 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
if (SUB_CHAR_TABLE_P (subtree))
i = 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;
}
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;
case Lisp_String:
{
@@ -3625,11 +3612,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
substitute_in_interval contains part of the logic. */
INTERVAL root_interval = string_intervals (subtree);
- AUTO_CONS (arg, object, placeholder);
-
traverse_intervals_noorder (root_interval,
- &substitute_in_interval, arg);
-
+ substitute_in_interval, subst);
return subtree;
}
@@ -3641,12 +3625,10 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
/* 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 = Fcar (arg);
- Lisp_Object placeholder = Fcdr (arg);
-
- SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value));
+ set_interval_plist (interval,
+ substitute_object_recurse (arg, interval->plist));
}
\f
@@ -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 = Qnil;
staticpro (&read_objects_completed);
read_objects_completed = Qnil;
- staticpro (&seen_list);
- seen_list = Qnil;
Vloads_in_progress = 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)
\f
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);
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;
case Lisp_Cons:
@@ -1263,7 +1263,7 @@ Fills `print-number-table'. */)
}
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!")))))
+(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
--
2.7.4
^ permalink raw reply related [flat|nested] 7+ messages in thread
end of thread, other threads:[~2017-07-09 23:30 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-05-31 2:29 bug#23660: edebug doesn't support circular object read syntax Noam Postavsky
2016-05-31 14:53 ` Michael Heerdegen
2016-05-31 15:13 ` Noam Postavsky
2017-02-20 18:33 ` bug#23660: Patch (was: bug#23660: edebug doesn't support circular object read syntax) Gemini Lasswell
2017-02-20 19:39 ` bug#23660: Patch for (edebug " npostavs
2017-02-24 1:29 ` npostavs
[not found] <a1a0386b-0307-3c16-08ab-64bcaee1f1c5@cs.ucla.edu>
2017-07-09 23:30 ` bug#23660: edebug doesn't support circular object read syntax Paul Eggert
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.