This is an automated email from the git hooks/post-receive script.
wingo pushed a commit to branch main
in repository guile.
The following commit(s) were added to refs/heads/main by this push:
new 1f724ccd3 Fix embarrassing pretty-print bug
1f724ccd3 is described below
commit 1f724ccd39cf4c20bc28a8f2d1489ad186515c47
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu Aug 24 12:10:50 2023 +0200
Fix embarrassing pretty-print bug
* module/ice-9/pretty-print.scm (pretty-print): We were never indenting
more than 8 spaces. Doh!
* test-suite/tests/print.test (prints?, "pretty-print"): Add test.
---
module/ice-9/pretty-print.scm | 2 +-
test-suite/tests/print.test | 24 ++++++++++++++++++++----
2 files changed, 21 insertions(+), 5 deletions(-)
diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index 38d05b7f3..4b403370c 100644
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -106,7 +106,7 @@ port directly after OBJ, like (pretty-print OBJ PORT)."
(when (< 0 n)
(put-string port " " 0 (min 8 n))
(when (< 8 n)
- (spaces (- 8 n)))))
+ (spaces (- n 8)))))
(define (indent to)
(let ((col (port-column port)))
diff --git a/test-suite/tests/print.test b/test-suite/tests/print.test
index f2e31451c..729a5342b 100644
--- a/test-suite/tests/print.test
+++ b/test-suite/tests/print.test
@@ -1,6 +1,6 @@
;;;; -*- coding: utf-8; mode: scheme; -*-
;;;;
-;;;; Copyright (C) 2010, 2013, 2014 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2013, 2014, 2023 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -23,11 +23,11 @@
(define-syntax prints?
;; #t if EXP prints as RESULT.
(syntax-rules ()
- ((_ exp result)
+ ((_ exp result arg ...)
(string=? result
(with-output-to-string
(lambda ()
- (pretty-print 'exp)))))))
+ (pretty-print 'exp arg ...)))))))
(define (with-print-options opts thunk)
(let ((saved-options (print-options)))
@@ -111,7 +111,23 @@
(pass-if "quasiquote & co."
(prints? (define foo `(bar ,(+ 2 3)))
- "(define foo `(bar ,(+ 2 3)))\n")))
+ "(define foo `(bar ,(+ 2 3)))\n"))
+
+ (pass-if "indent"
+ (prints? (9 (8 (7 (6 (5 (4 (3 (2 (1 (0 0))))))))))
+ (string-append
+ "(9\n"
+ " (8\n"
+ " (7\n"
+ " (6\n"
+ " (5\n"
+ " (4\n"
+ " (3\n"
+ " (2\n"
+ " (1\n"
+ " (0\n"
+ " 0))))))))))\n")
+ #:width 10)))
(with-test-prefix "truncated-print"
