summaryrefslogtreecommitdiff
path: root/tests/read-print.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/read-print.scm')
-rw-r--r--tests/read-print.scm209
1 files changed, 209 insertions, 0 deletions
diff --git a/tests/read-print.scm b/tests/read-print.scm
new file mode 100644
index 0000000000..e9ba1127d4
--- /dev/null
+++ b/tests/read-print.scm
@@ -0,0 +1,209 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests-style)
+ #:use-module (guix read-print)
+ #:use-module (guix gexp) ;for the reader extensions
+ #:use-module (srfi srfi-64))
+
+(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 "read-print")
+
+(test-equal "read-with-comments: dot notation"
+ (cons 'a 'b)
+ (call-with-input-string "(a . b)"
+ read-with-comments))
+
+(test-pretty-print "(list 1 2 3 4)")
+(test-pretty-print "((a . 1) (b . 2))")
+(test-pretty-print "(a b c . boom)")
+(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-pretty-print "\
+(modify-phases %standard-phases
+ (replace 'build
+ ;; Nicely indented in 'modify-phases' context.
+ (lambda _
+ #t)))")
+
+(test-pretty-print "\
+(modify-inputs inputs
+ ;; Regular indentation for 'replace' here.
+ (replace \"gmp\" gmp))")
+
+(test-pretty-print "\
+(package
+ ;; Here 'sha256', 'base32', and 'arguments' must be
+ ;; immediately followed by a newline.
+ (source (origin
+ (method url-fetch)
+ (sha256
+ (base32
+ \"not a real base32 string\"))))
+ (arguments
+ '(#:phases %standard-phases
+ #:tests? #f)))")
+
+;; '#:key value' is kept on the same line.
+(test-pretty-print "\
+(package
+ (name \"keyword-value-same-line\")
+ (arguments
+ (list #:phases #~(modify-phases %standard-phases
+ (add-before 'x 'y
+ (lambda* (#:key inputs #:allow-other-keys)
+ (foo bar baz))))
+ #:make-flags #~'(\"ANSWER=42\")
+ #:tests? #f)))")
+
+(test-pretty-print "\
+(let ((x 1)
+ (y 2)
+ (z (let* ((a 3)
+ (b 4))
+ (+ a b))))
+ (list x y z))")
+
+(test-pretty-print "\
+(substitute-keyword-arguments (package-arguments x)
+ ((#:phases phases)
+ `(modify-phases ,phases
+ (add-before 'build 'do-things
+ (lambda _
+ #t))))
+ ((#:configure-flags flags)
+ `(cons \"--without-any-problem\"
+ ,flags)))")
+
+(test-equal "pretty-print-with-comments, canonicalize-comment"
+ "\
+(list abc
+ ;; Not a margin comment.
+ ;; Ditto.
+ ;;
+ ;; There's a blank line above.
+ def ;margin comment
+ ghi)"
+ (let ((sexp (call-with-input-string
+ "\
+(list abc
+ ;Not a margin comment.
+ ;;; Ditto.
+ ;;;;;
+ ; There's a blank line above.
+ def ;; margin comment
+ ghi)"
+ read-with-comments)))
+ (call-with-output-string
+ (lambda (port)
+ (pretty-print-with-comments port sexp
+ #:format-comment
+ canonicalize-comment)))))
+
+(test-end)