diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/read-print.scm | 209 | ||||
| -rw-r--r-- | tests/style.scm | 181 |
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) |