summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-12-28 21:51:20 +0100
committerLudovic Courtès <ludo@gnu.org>2022-01-10 14:25:59 +0100
commit97d0055edb9a8b9b59ede254ce8ef1f255558802 (patch)
tree3b083189e66cc7a5804ee2368e20a027981fbd80 /tests
parent3dcc74d3ae605c965a37519524c51a328f0a25e2 (diff)
style: Improve pretty printer and add tests.
* guix/scripts/style.scm (vhashq): New macro. (%special-forms): New variable. (special-form?): New procedure. (pretty-print-with-comments): Add many clauses and tweak existing rules. * tests/style.scm (test-pretty-print): New macro. <top level>: Add 'test-pretty-print' tests.
Diffstat (limited to 'tests')
-rw-r--r--tests/style.scm95
1 files changed, 95 insertions, 0 deletions
diff --git a/tests/style.scm b/tests/style.scm
index ada9197fc1..d9e8d803f4 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -21,6 +21,7 @@
#:use-module (guix scripts style)
#:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module ((guix build utils) #:select (substitute*))
+ #:use-module (guix gexp) ;for the reader extension
#:use-module (guix diagnostics)
#:use-module (gnu packages acl)
#:use-module (gnu packages multiprecision)
@@ -111,6 +112,17 @@
(lambda (port)
(read-lines port line count)))))
+(define-syntax-rule (test-pretty-print str args ...)
+ "Test equality after a round-trip where STR is passed to
+'read-with-comments' and the resulting sexp is then passed to
+'pretty-print-with-comments'."
+ (test-equal str
+ (call-with-output-string
+ (lambda (port)
+ (let ((exp (call-with-input-string str
+ read-with-comments)))
+ (pretty-print-with-comments port exp args ...))))))
+
(test-begin "style")
@@ -358,6 +370,89 @@
(list (package-inputs (@ (my-packages) my-coreutils))
(read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
+(test-pretty-print "(list 1 2 3 4)")
+(test-pretty-print "(list 1
+ 2
+ 3
+ 4)"
+ #:long-list 3
+ #:indent 20)
+(test-pretty-print "\
+(list abc
+ def)"
+ #:max-width 11)
+(test-pretty-print "\
+(#:foo
+ #:bar)"
+ #:max-width 10)
+
+(test-pretty-print "\
+(#:first 1
+ #:second 2
+ #:third 3)")
+
+(test-pretty-print "\
+((x
+ 1)
+ (y
+ 2)
+ (z
+ 3))"
+ #:max-width 3)
+
+(test-pretty-print "\
+(let ((x 1)
+ (y 2)
+ (z 3)
+ (p 4))
+ (+ x y))"
+ #:max-width 11)
+
+(test-pretty-print "\
+(lambda (x y)
+ ;; This is a procedure.
+ (let ((z (+ x y)))
+ (* z z)))")
+
+(test-pretty-print "\
+#~(string-append #$coreutils \"/bin/uname\")")
+
+(test-pretty-print "\
+(package
+ (inherit coreutils)
+ (version \"42\"))")
+
+(test-pretty-print "\
+(modify-phases %standard-phases
+ (add-after 'unpack 'post-unpack
+ (lambda _
+ #t))
+ (add-before 'check 'pre-check
+ (lambda* (#:key inputs #:allow-other-keys)
+ do things ...)))")
+
+(test-pretty-print "\
+(#:phases (modify-phases sdfsdf
+ (add-before 'x 'y
+ (lambda _
+ xyz))))")
+
+(test-pretty-print "\
+(description \"abcdefghijkl
+mnopqrstuvwxyz.\")"
+ #:max-width 30)
+
+(test-pretty-print "\
+(description
+ \"abcdefghijkl
+mnopqrstuvwxyz.\")"
+ #:max-width 12)
+
+(test-pretty-print "\
+(description
+ \"abcdefghijklmnopqrstuvwxyz\")"
+ #:max-width 33)
+
(test-end)
;; Local Variables: