From c3b1cfe76b7038f4030d7d207ffc417fed9a7ead Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 1 Sep 2022 15:54:08 +0200
Subject: read-print: Guess the base to use for integers being printed.

Fixes <https://issues.guix.gnu.org/57090>.
Reported by Christopher Rodriguez <yewscion@gmail.com>.

* 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)
-- 
cgit 1.4.1