From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: npostavs@users.sourceforge.net Newsgroups: gmane.emacs.bugs Subject: bug#27117: 26.0.50; Setting cl-print-compiled to `static' has problems if print-circle isn't set Date: Sun, 28 May 2017 17:13:24 -0400 Message-ID: <87vaok4rd7.fsf@users.sourceforge.net> References: <871sr958sy.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1496005932 31661 195.159.176.226 (28 May 2017 21:12:12 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 28 May 2017 21:12:12 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2.50 (gnu/linux) Cc: 27117@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun May 28 23:12:08 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 1dF5Tr-00085Q-Py for geb-bug-gnu-emacs@m.gmane.org; Sun, 28 May 2017 23:12:08 +0200 Original-Received: from localhost ([::1]:45265 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dF5Tw-0007kx-VK for geb-bug-gnu-emacs@m.gmane.org; Sun, 28 May 2017 17:12:13 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:32940) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dF5Tp-0007jR-4H for bug-gnu-emacs@gnu.org; Sun, 28 May 2017 17:12:06 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dF5Tm-000099-07 for bug-gnu-emacs@gnu.org; Sun, 28 May 2017 17:12:05 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:39475) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dF5Tl-000095-SH for bug-gnu-emacs@gnu.org; Sun, 28 May 2017 17:12:01 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dF5Tl-00025R-Mi for bug-gnu-emacs@gnu.org; Sun, 28 May 2017 17:12:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 28 May 2017 21:12:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 27117 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 27117-submit@debbugs.gnu.org id=B27117.14960059158008 (code B ref 27117); Sun, 28 May 2017 21:12:01 +0000 Original-Received: (at 27117) by debbugs.gnu.org; 28 May 2017 21:11:55 +0000 Original-Received: from localhost ([127.0.0.1]:42152 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dF5Tf-000251-5V for submit@debbugs.gnu.org; Sun, 28 May 2017 17:11:55 -0400 Original-Received: from mail-it0-f46.google.com ([209.85.214.46]:37581) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dF5Td-00024j-JE; Sun, 28 May 2017 17:11:53 -0400 Original-Received: by mail-it0-f46.google.com with SMTP id g126so18654859ith.0; Sun, 28 May 2017 14:11:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=hcsl6qR0ncaC7LZWUCXeiJj+1hK4LwKT6sW5Jd7tyDY=; b=DDPQGEcICcikUz+dgq7pj0b2jlNeUQc7Dy1a0b1tx8Ni5kd0AGSVXWSM9QDr+oS28N v5Wj0CuD6PprIUrfX0ZW1yYVtjTw6sSGMMQDmsccFfLhowSCSNNRizz3l8OfTucUALrh Is2OyFZ8TxSXeM8H1tmY5Gnvpg94yvBd1E5NbwPoAZ+sbRsfP91kJlVOGFYRuZuAKPa2 KEpWGBLFu275UYo8TomAYvxGbpTTDjteGJu50dMS9mIZiu49H3sJw+InlSw4PXyNaS1w ZsVxnXuP8ibwH2YQQPlZcrh45dTy9bo3bja1zGXFMoVK4d6fFa1vpfv6wgDalp9feomE ajQA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=hcsl6qR0ncaC7LZWUCXeiJj+1hK4LwKT6sW5Jd7tyDY=; b=XkG1iPz9nvOGw6jNKyyqKTdHqLEKBQQoiHgj+bANukTFm9eheb2KXWaJuPL1H+N5cF P+ddKWFOqrvZD9V5bUFSeoMQYGZLdjiwqtMVCJsrkD7He4DGo+UNyiXVDEDY4kIAIUsz DGjhXYjF4TBtvtuExEhW+vHPmR6E/LLZuyTvDxgUCH/SxIk+FmVf6AVLxVfGi+nWywfb rnjyxK6nDEO1FPf245l2E17fDJIw4ItYdpV4nlSOTLwBtvMlSi2jAMct41isrH8kcj3/ AeCvfIwnHhvJiAgS13PnRbDUWW+OxWkKiAGd6vHiY2GejAyU+BoJH6yC6c0bA0SNbN2P uvOA== X-Gm-Message-State: AODbwcCutf8YWLP14UakrSgd7yCPoH8K4fM+gQpHNgxyJeMnYAlvD0wo aL7BpYxnL8J5UhNK X-Received: by 10.36.228.141 with SMTP id o135mr11220578ith.40.1496005907920; Sun, 28 May 2017 14:11:47 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id b69sm3866939itb.23.2017.05.28.14.11.46 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sun, 28 May 2017 14:11:47 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Sun, 28 May 2017 14:33:08 -0400") 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:132970 Archived-At: --=-=-= Content-Type: text/plain retitle 27117 26.0.50; cl-print loops endlessly on circular objects if print-circle is nil tags 27117 patch quit Stefan Monnier writes: > > Indeed, prin1 has a two ways to prevent infinite recursion: > - limit the print to a certain depth > - detect when we start printing that we're already in the process of > printing, and then replace it with #N where N is some kind of depth of > the reference (so #0 refers to the whole object that we're in the > process of printing). > > cl-prin1 doesn't offer these safety belts, currently (I always set > print-circle). Oh, I see, it's not specific to bytecode functions at all. Here's a patch implementing the 2nd safety belt: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=v1-0001-cl-print-handle-circular-objects-when-print-circl.patch Content-Description: patch >From e0eb1fb4fbff0f7c27c4c7fcef01ce30e86e600b Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 28 May 2017 17:01:05 -0400 Subject: [PATCH v1] cl-print: handle circular objects when `print-circle' is nil (Bug#27117) * lisp/emacs-lisp/cl-print.el (cl-print--currently-printing): New variable. (cl-print-object): When `print-circle' is nil, bind it to a list of objects that are currently printing to avoid printing the same object endlessly. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-circle): New test. --- lisp/emacs-lisp/cl-print.el | 35 +++++++++++++++++++++++----------- test/lisp/emacs-lisp/cl-print-tests.el | 8 ++++++++ 2 files changed, 32 insertions(+), 11 deletions(-) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 3958ee80a3..6703fc99e2 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -39,6 +39,7 @@ (defvar cl-print-readably nil "If non-nil, try and make sure the result can be `read'.") (defvar cl-print--number-table nil) +(defvar cl-print--currently-printing nil) ;;;###autoload (cl-defgeneric cl-print-object (object stream) @@ -61,8 +62,9 @@ (cl-defmethod cl-print-object ((object cons) stream) (princ "(" stream) (cl-print-object car stream) (while (and (consp object) - (not (and cl-print--number-table - (numberp (gethash object cl-print--number-table))))) + (not (if cl-print--number-table + (numberp (gethash object cl-print--number-table)) + (memq object cl-print--currently-printing)))) (princ " " stream) (cl-print-object (pop object) stream)) (when object @@ -181,15 +183,26 @@ (cl-defmethod cl-print-object ((object cl-structure-object) stream) (cl-defmethod cl-print-object :around (object stream) ;; FIXME: Only put such an :around method on types where it's relevant. - (let ((n (if cl-print--number-table (gethash object cl-print--number-table)))) - (if (not (numberp n)) - (cl-call-next-method) - (if (> n 0) - ;; Already printed. Just print a reference. - (progn (princ "#" stream) (princ n stream) (princ "#" stream)) - (puthash object (- n) cl-print--number-table) - (princ "#" stream) (princ (- n) stream) (princ "=" stream) - (cl-call-next-method))))) + (cond + (print-circle + (let ((n (gethash object cl-print--number-table))) + (if (not (numberp n)) + (cl-call-next-method) + (if (> n 0) + ;; Already printed. Just print a reference. + (progn (princ "#" stream) (princ n stream) (princ "#" stream)) + (puthash object (- n) cl-print--number-table) + (princ "#" stream) (princ (- n) stream) (princ "=" stream) + (cl-call-next-method))))) + ((let ((already-printing (memq object cl-print--currently-printing))) + (when already-printing + ;; Currently printing, just print reference to avoid endless + ;; recursion. + (princ "#" stream) + (princ (length (cdr already-printing)) stream)))) + (t (let ((cl-print--currently-printing + (cons object cl-print--currently-printing))) + (cl-call-next-method))))) (defvar cl-print--number-index nil) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 27d038a166..6448a1b37f 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -47,4 +47,12 @@ (ert-deftest cl-print-tests-2 () "\\`(#1=#s(foo 1 2 3) #1#)\\'" (cl-prin1-to-string (list x x))))))) +(ert-deftest cl-print-circle () + (let ((x '(#1=(a . #1#) #1#))) + (let ((print-circle nil)) + (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'" + (cl-prin1-to-string x)))) + (let ((print-circle t)) + (should (equal "(#1=(a . #1#) #1#)" (cl-prin1-to-string x)))))) + ;;; cl-print-tests.el ends here. -- 2.11.1 --=-=-=--