diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/guix-home.sh | 5 | ||||
| -rw-r--r-- | tests/guix-style.sh | 80 | ||||
| -rw-r--r-- | tests/read-print.scm | 380 | ||||
| -rw-r--r-- | tests/services/configuration.scm | 26 | ||||
| -rw-r--r-- | tests/style.scm | 185 |
5 files changed, 488 insertions, 188 deletions
diff --git a/tests/guix-home.sh b/tests/guix-home.sh index 1d1acbfd6e..d5e2dadbb5 100644 --- a/tests/guix-home.sh +++ b/tests/guix-home.sh @@ -107,7 +107,10 @@ EOF if container_supported then - # Run the home in a container. + # Run the home in a container. Always use bash inside container for + # reproducibility of the tests. + # TODO: Make container independent from external environment variables. + SHELL=bash guix home container home.scm -- true ! guix home container home.scm -- false test "$(guix home container home.scm -- echo '$HOME')" = "$HOME" diff --git a/tests/guix-style.sh b/tests/guix-style.sh new file mode 100644 index 0000000000..58f953a0ec --- /dev/null +++ b/tests/guix-style.sh @@ -0,0 +1,80 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 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/>. + +# +# Test 'guix style'. +# + +set -e + +guix style --version + +tmpdir="guix-style-$$" +trap 'rm -r "$tmpdir"' EXIT + +tmpfile="$tmpdir/os.scm" +mkdir "$tmpdir" +cat > "$tmpfile" <<EOF +;;; This is a header with three semicolons. +;;; + +(define-module (foo bar) + #:use-module (guix) + #:use-module (gnu)) + +;; One blank line and a page break. + + +;; And now, the OS. +(operating-system + (host-name "komputilo") + (locale "eo_EO.UTF-8") + + ;; User accounts. + (users (cons (user-account + (name "alice") + (comment "Bob's sister") + (group "users") + + ;; Groups fit on one line. + (supplementary-groups '("wheel" "audio" "video"))) + %base-user-accounts)) + + ;; The services. + (services + (cons (service mcron-service-type) %base-services))) +EOF + +cp "$tmpfile" "$tmpfile.bak" + +initial_hash="$(guix hash "$tmpfile")" + +guix style -f "$tmpfile" +if ! test "$initial_hash" = "$(guix hash "$tmpfile")" +then + cat "$tmpfile" + diff -u "$tmpfile.bak" "$tmpfile" + false +fi + +# Introduce random changes and try again. +sed -i "$tmpfile" -e's/ +/ /g' +! test "$initial_hash" = "$(guix hash "$tmpfile")" + +guix style -f "$tmpfile" +test "$initial_hash" = "$(guix hash "$tmpfile")" diff --git a/tests/read-print.scm b/tests/read-print.scm new file mode 100644 index 0000000000..4dabcc1e64 --- /dev/null +++ b/tests/read-print.scm @@ -0,0 +1,380 @@ +;;; 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-34) + #:use-module (srfi srfi-35) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(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 ...)))))) + +(define-syntax-rule (test-pretty-print/sequence str args ...) + "Likewise, but read and print entire sequences rather than individual +expressions." + (test-equal str + (call-with-output-string + (lambda (port) + (let ((lst (call-with-input-string str + read-with-comments/sequence))) + (pretty-print-with-comments/splice port lst args ...)))))) + + +(test-begin "read-print") + +(test-assert "read-with-comments: missing closing paren" + (guard (c ((error? c) #t)) + (call-with-input-string "(what is going on?" + read-with-comments))) + +(test-equal "read-with-comments: dot notation" + (cons 'a 'b) + (call-with-input-string "(a . b)" + read-with-comments)) + +(test-equal "read-with-comments: list with blank line" + `(list with ,(vertical-space 1) blank line) + (call-with-input-string "\ +(list with + + blank line)\n" + read-with-comments)) + +(test-equal "read-with-comments: list with multiple blank lines" + `(list with ,(comment ";multiple\n" #t) + ,(vertical-space 3) blank lines) + (call-with-input-string "\ +(list with ;multiple + + + + blank lines)\n" + read-with-comments)) + +(test-equal "read-with-comments: top-level blank lines" + (list (vertical-space 2) '(a b c) (vertical-space 2)) + (call-with-input-string " + +(a b c)\n\n" + (lambda (port) + (list (read-with-comments port) + (read-with-comments port) + (read-with-comments port))))) + +(test-equal "read-with-comments: top-level page break" + (list (comment ";; Begin.\n") (vertical-space 1) + (page-break) + (comment ";; End.\n")) + (call-with-input-string "\ +;; Begin. + + +;; End.\n" + (lambda (port) + (list (read-with-comments port) + (read-with-comments port) + (read-with-comments port) + (read-with-comments port))))) + +(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 "\ +(case x + ((1) + 'one) + ((2) + 'two))") + +(test-pretty-print "\ +(cond + ((zero? x) + 'zero) + ((odd? x) + 'odd) + (else #f))") + +(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-pretty-print "\ +(vertical-space one: + + two: + + + three: + + + + end)") + +(test-pretty-print "\ +(vertical-space one + + ;; Comment after blank line. + two)") + +(test-pretty-print "\ +(begin + break + + ;; page break above + end)") + +(test-pretty-print/sequence "\ +;;; This is a top-level comment. + + +;; Above is a page break. +(this is an sexp + ;; with a comment + !!) + +;; The end.\n") + +(test-pretty-print/sequence " +;;; Hello! +;;; Notice that there are three semicolons here. + +(define-module (foo bar) + #:use-module (guix) + #:use-module (gnu)) + + +;; And now, the OS. +(operating-system + (host-name \"komputilo\") + (locale \"eo_EO.UTF-8\") + + (services + (cons (service mcron-service-type) %base-services)))\n" + #:format-comment canonicalize-comment) + +(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-equal "pretty-print-with-comments, canonicalize-vertical-space" + "\ +(list abc + + def + + ;; last one + ghi)" + (let ((sexp (call-with-input-string + "\ +(list abc + + + + def + + +;; last one + ghi)" + read-with-comments))) + (call-with-output-string + (lambda (port) + (pretty-print-with-comments port sexp + #:format-vertical-space + canonicalize-vertical-space))))) + +(test-equal "pretty-print-with-comments, multi-line comment" + "\ +(list abc + ;; This comment spans + ;; two lines. + def)" + (call-with-output-string + (lambda (port) + (pretty-print-with-comments port + `(list abc ,(comment "\ +;; This comment spans\n +;; two lines.\n") + def))))) + +(test-end) diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm index 6268525317..649dad26e8 100644 --- a/tests/services/configuration.scm +++ b/tests/services/configuration.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> ;;; @@ -141,6 +141,24 @@ (config-with-maybe-number (port 42)))) +(define (serialize-symbol name value) + (format #f "~a=~a~%" name value)) + +(define-maybe symbol) + +(define-configuration config-with-maybe-symbol + (protocol maybe-symbol "")) + +;;; Maybe symbol values are currently seen as serializable, because the +;;; unspecified value is 'unset, which is a symbol itself. +;;; TODO: Remove expected fail marker after resolution. +(test-expect-fail 1) +(test-equal "symbol maybe value serialization, unspecified" + "" + (gexp->approximate-sexp + (serialize-configuration (config-with-maybe-symbol) + config-with-maybe-symbol-fields))) + (define-maybe/no-serialization string) (define-configuration config-with-maybe-string/no-serialization @@ -151,9 +169,9 @@ (not (defined? 'serialize-maybe-string))) (test-assert "maybe type, no default" - (unspecified? - (config-with-maybe-string/no-serialization-name - (config-with-maybe-string/no-serialization)))) + (eq? 'unset + (config-with-maybe-string/no-serialization-name + (config-with-maybe-string/no-serialization)))) (test-assert "maybe type, with default" (equal? diff --git a/tests/style.scm b/tests/style.scm index 55bad2b3ba..6aab2c3785 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") @@ -366,9 +355,9 @@ (substitute* file ((",gmp\\)(.*)$" _ rest) - (string-append ",gmp) ;margin comment\n" rest)) + (string-append ",gmp) ;margin comment" rest)) ((",acl\\)(.*)$" _ rest) - (string-append ",acl) ;another one\n" rest))) + (string-append ",acl) ;another one" rest))) (system* "guix" "style" "-L" directory "-S" "inputs" "my-coreutils") @@ -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) |