aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-07-20 19:11:21 +0200
committerLudovic Courtès <ludo@gnu.org>2022-08-08 11:22:31 +0200
commit5817e222faf46f76fbdb66ba8fd6c8cd643aefb5 (patch)
treea5381405268e393c65f24f532a38d01635412aad /tests
parentbc3eaf9d83c5f227681f43bbc70067d92fc72193 (diff)
downloadguix-5817e222faf46f76fbdb66ba8fd6c8cd643aefb5.tar
guix-5817e222faf46f76fbdb66ba8fd6c8cd643aefb5.tar.gz
style: Move reader and printer to (guix read-print).
* guix/scripts/style.scm (<comment>, read-with-comments) (vhashq, %special-forms, %newline-forms, prefix?) (special-form-lead, newline-form?, escaped-string) (string-width, canonicalize-comment, pretty-print-with-comments) (object->string*): Move to... * guix/read-print.scm: ... here. New file. * guix/scripts/import.scm: Adjust accordingly. * tests/style.scm: Move 'test-pretty-print' and tests to... * tests/read-print.scm: ... here. New file. * Makefile.am (MODULES): Add 'guix/read-print.scm'. (SCM_TESTS): Add 'tests/read-print.scm'.
Diffstat (limited to 'tests')
-rw-r--r--tests/read-print.scm209
-rw-r--r--tests/style.scm181
2 files changed, 209 insertions, 181 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)
diff --git a/tests/style.scm b/tests/style.scm
index 55bad2b3ba..4ac5ae7c09 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -113,17 +113,6 @@
(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")
@@ -377,176 +366,6 @@
(list (package-inputs (@ (my-packages) my-coreutils))
(read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
-(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)