civodul pushed a commit to branch master
in repository guix.
commit c3b1cfe76b7038f4030d7d207ffc417fed9a7ead
Author: Ludovic Courtès <[email protected]>
AuthorDate: Thu Sep 1 15:54:08 2022 +0200
read-print: Guess the base to use for integers being printed.
Fixes <https://issues.guix.gnu.org/57090>.
Reported by Christopher Rodriguez <[email protected]>.
* guix/read-print.scm (%symbols-followed-by-octal-integers)
(%symbols-followed-by-hexadecimal-integers): New variables.
* guix/read-print.scm (integer->string): New procedure.
(pretty-print-with-comments): Use it.
* tests/read-print.scm: Add test.
---
guix/read-print.scm | 38 +++++++++++++++++++++++++++++++++++---
tests/read-print.scm | 8 ++++++++
2 files changed, 43 insertions(+), 3 deletions(-)
diff --git a/guix/read-print.scm b/guix/read-print.scm
index 63ff9ca5bd..00dde870f4 100644
--- a/guix/read-print.scm
+++ b/guix/read-print.scm
@@ -22,6 +22,7 @@
#:use-module (ice-9 rdelim)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (guix i18n)
@@ -426,6 +427,34 @@ each line except the first one (they're assumed to be
already there)."
(display (make-string indent #\space) port)
(loop tail)))))
+(define %symbols-followed-by-octal-integers
+ ;; Symbols for which the following integer must be printed as octal.
+ '(chmod umask mkdir mkstemp))
+
+(define %symbols-followed-by-hexadecimal-integers
+ ;; Likewise, for hexadecimal integers.
+ '(logand logior logxor lognot))
+
+(define (integer->string integer context)
+ "Render INTEGER as a string using a base suitable based on CONTEXT."
+ (define base
+ (match context
+ ((head . tail)
+ (cond ((memq head %symbols-followed-by-octal-integers) 8)
+ ((memq head %symbols-followed-by-hexadecimal-integers)
+ (if (any (cut memq <> %symbols-followed-by-octal-integers)
+ tail)
+ 8
+ 16))
+ (else 10)))
+ (_ 10)))
+
+ (string-append (match base
+ (10 "")
+ (16 "#x")
+ (8 "#o"))
+ (number->string integer base)))
+
(define* (pretty-print-with-comments port obj
#:key
(format-comment
@@ -661,9 +690,12 @@ FORMAT-VERTICAL-SPACE; a useful value of
'canonicalize-vertical-space'."
(display ")" port)
(+ column 1)))))
(_
- (let* ((str (if (string? obj)
- (escaped-string obj)
- (object->string obj)))
+ (let* ((str (cond ((string? obj)
+ (escaped-string obj))
+ ((integer? obj)
+ (integer->string obj context))
+ (else
+ (object->string obj))))
(len (string-width str)))
(if (and (> (+ column 1 len) max-width)
(not delimited?))
diff --git a/tests/read-print.scm b/tests/read-print.scm
index 4dabcc1e64..1b0d865972 100644
--- a/tests/read-print.scm
+++ b/tests/read-print.scm
@@ -247,6 +247,14 @@ mnopqrstuvwxyz.\")"
(+ a b))))
(list x y z))")
+(test-pretty-print "\
+(begin
+ (chmod \"foo\" #o750)
+ (chmod port
+ (logand #o644
+ (lognot (umask))))
+ (logand #x7f xyz))")
+
(test-pretty-print "\
(substitute-keyword-arguments (package-arguments x)
((#:phases phases)
