diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2022-09-01 15:54:08 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-09-01 18:31:26 +0200 |
| commit | c3b1cfe76b7038f4030d7d207ffc417fed9a7ead (patch) | |
| tree | dd1e118336d2d1f915c003ac3af46b374fe9c043 | |
| parent | 8cf7997d7c068eb87eadbd28ac8be4e0aeddbba3 (diff) | |
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.
| -rw-r--r-- | guix/read-print.scm | 38 | ||||
| -rw-r--r-- | 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 @@ -248,6 +248,14 @@ mnopqrstuvwxyz.\")" (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) `(modify-phases ,phases |