;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021-2023 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: half dot notation" '(lambda x x) (call-with-input-string "(lambda (. x) x)" 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 "\ (begin 1+ 1- 123/ 456* (1+ 41))") (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 "\ (string-append \"a\\tb\" \"\\n\")") (test-pretty-print "\ (display \"This is a very long string. It contains line breaks, which are preserved, because it's a long string.\")") (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 "\ (list ;margin comment a b c)") (test-pretty-print "\ (list ;; This is a line comment immediately following the list head. #:test-flags #~(list \"-m\" \"not external and not samples\"))") (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 "\ #~(modify-phases phases (add-after 'whatever 'something-else (lambda _ ;; This comment appears inside a gexp. 42)))") (test-pretty-print "\ #~(list #$@(list coreutils ;yup grep) ;margin comment #+sed ;; Line comment. #$grep)") (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 "\ (begin (chmod \"foo\" #o750) (chmod port (logand #o644 (lognot (umask)))) (logand #x7f xyz))") (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 "\ (home-environment (services (list (service-type home-bash-service-type))))") (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)