tests/read-print.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (tests-style)
  20   #:use-module (guix read-print)
  21   #:use-module (guix gexp)                        ;for the reader extensions
  22   #:use-module (srfi srfi-34)
  23   #:use-module (srfi srfi-35)
  24   #:use-module (srfi srfi-64)
  25   #:use-module (ice-9 match))
  26
  27 (define-syntax-rule (test-pretty-print str args ...)
  28   "Test equality after a round-trip where STR is passed to
  29 'read-with-comments' and the resulting sexp is then passed to
  30 'pretty-print-with-comments'."
  31   (test-equal str
  32     (call-with-output-string
  33       (lambda (port)
  34         (let ((exp (call-with-input-string str
  35                      read-with-comments)))
  36          (pretty-print-with-comments port exp args ...))))))
  37
  38 (define-syntax-rule (test-pretty-print/sequence str args ...)
  39   "Likewise, but read and print entire sequences rather than individual
  40 expressions."
  41   (test-equal str
  42     (call-with-output-string
  43       (lambda (port)
  44         (let ((lst (call-with-input-string str
  45                      read-with-comments/sequence)))
  46          (pretty-print-with-comments/splice port lst args ...))))))
  47
  48 \f
  49 (test-begin "read-print")
  50
  51 (test-assert "read-with-comments: missing closing paren"
  52   (guard (c ((error? c) #t))
  53     (call-with-input-string "(what is going on?"
  54       read-with-comments)))
  55
  56 (test-equal "read-with-comments: dot notation"
  57   (cons 'a 'b)
  58   (call-with-input-string "(a . b)"
  59     read-with-comments))
  60
  61 (test-equal "read-with-comments: list with blank line"
  62   `(list with ,(vertical-space 1) blank line)
  63   (call-with-input-string "\
  64 (list with
  65
  66       blank line)\n"
  67     read-with-comments))
  68
  69 (test-equal "read-with-comments: list with multiple blank lines"
  70   `(list with ,(comment ";multiple\n" #t)
  71          ,(vertical-space 3) blank lines)
  72   (call-with-input-string "\
  73 (list with ;multiple
  74
  75
  76
  77       blank lines)\n"
  78     read-with-comments))
  79
  80 (test-equal "read-with-comments: top-level blank lines"
  81   (list (vertical-space 2) '(a b c) (vertical-space 2))
  82   (call-with-input-string "
  83
  84 (a b c)\n\n"
  85     (lambda (port)
  86       (list (read-with-comments port)
  87             (read-with-comments port)
  88             (read-with-comments port)))))
  89
  90 (test-equal "read-with-comments: top-level page break"
  91   (list (comment ";; Begin.\n") (vertical-space 1)
  92         (page-break)
  93         (comment ";; End.\n"))
  94   (call-with-input-string "\
  95 ;; Begin.
  96
  97 \f
  98 ;; End.\n"
  99     (lambda (port)
 100       (list (read-with-comments port)
 101             (read-with-comments port)
 102             (read-with-comments port)
 103             (read-with-comments port)))))
 104
 105 (test-pretty-print "(list 1 2 3 4)")
 106 (test-pretty-print "((a . 1) (b . 2))")
 107 (test-pretty-print "(a b c . boom)")
 108 (test-pretty-print "(list 1
 109                           2
 110                           3
 111                           4)"
 112                    #:long-list 3
 113                    #:indent 20)
 114 (test-pretty-print "\
 115 (list abc
 116       def)"
 117                    #:max-width 11)
 118 (test-pretty-print "\
 119 (#:foo
 120  #:bar)"
 121                    #:max-width 10)
 122
 123 (test-pretty-print "\
 124 (#:first 1
 125  #:second 2
 126  #:third 3)")
 127
 128 (test-pretty-print "\
 129 ((x
 130   1)
 131  (y
 132   2)
 133  (z
 134   3))"
 135                    #:max-width 3)
 136
 137 (test-pretty-print "\
 138 (let ((x 1)
 139       (y 2)
 140       (z 3)
 141       (p 4))
 142   (+ x y))"
 143                    #:max-width 11)
 144
 145 (test-pretty-print "\
 146 (lambda (x y)
 147   ;; This is a procedure.
 148   (let ((z (+ x y)))
 149     (* z z)))")
 150
 151 (test-pretty-print "\
 152 (case x
 153   ((1)
 154    'one)
 155   ((2)
 156    'two))")
 157
 158 (test-pretty-print "\
 159 (cond
 160   ((zero? x)
 161    'zero)
 162   ((odd? x)
 163    'odd)
 164   (else #f))")
 165
 166 (test-pretty-print "\
 167 #~(string-append #$coreutils \"/bin/uname\")")
 168
 169 (test-pretty-print "\
 170 (package
 171   (inherit coreutils)
 172   (version \"42\"))")
 173
 174 (test-pretty-print "\
 175 (modify-phases %standard-phases
 176   (add-after 'unpack 'post-unpack
 177     (lambda _
 178       #t))
 179   (add-before 'check 'pre-check
 180     (lambda* (#:key inputs #:allow-other-keys)
 181       do things ...)))")
 182
 183 (test-pretty-print "\
 184 (#:phases (modify-phases sdfsdf
 185             (add-before 'x 'y
 186               (lambda _
 187                 xyz))))")
 188
 189 (test-pretty-print "\
 190 (string-append \"a\\tb\" \"\\n\")")
 191
 192 (test-pretty-print "\
 193 (description \"abcdefghijkl
 194 mnopqrstuvwxyz.\")"
 195                    #:max-width 30)
 196
 197 (test-pretty-print "\
 198 (description
 199  \"abcdefghijkl
 200 mnopqrstuvwxyz.\")"
 201                    #:max-width 12)
 202
 203 (test-pretty-print "\
 204 (description
 205  \"abcdefghijklmnopqrstuvwxyz\")"
 206                    #:max-width 33)
 207
 208 (test-pretty-print "\
 209 (modify-phases %standard-phases
 210   (replace 'build
 211     ;; Nicely indented in 'modify-phases' context.
 212     (lambda _
 213       #t)))")
 214
 215 (test-pretty-print "\
 216 (modify-inputs inputs
 217   ;; Regular indentation for 'replace' here.
 218   (replace \"gmp\" gmp))")
 219
 220 (test-pretty-print "\
 221 (package
 222   ;; Here 'sha256', 'base32', and 'arguments' must be
 223   ;; immediately followed by a newline.
 224   (source (origin
 225             (method url-fetch)
 226             (sha256
 227              (base32
 228               \"not a real base32 string\"))))
 229   (arguments
 230    '(#:phases %standard-phases
 231      #:tests? #f)))")
 232
 233 ;; '#:key value' is kept on the same line.
 234 (test-pretty-print "\
 235 (package
 236   (name \"keyword-value-same-line\")
 237   (arguments
 238    (list #:phases #~(modify-phases %standard-phases
 239                       (add-before 'x 'y
 240                         (lambda* (#:key inputs #:allow-other-keys)
 241                           (foo bar baz))))
 242          #:make-flags #~'(\"ANSWER=42\")
 243          #:tests? #f)))")
 244
 245 (test-pretty-print "\
 246 (let ((x 1)
 247       (y 2)
 248       (z (let* ((a 3)
 249                 (b 4))
 250            (+ a b))))
 251   (list x y z))")
 252
 253 (test-pretty-print "\
 254 (begin
 255   (chmod \"foo\" #o750)
 256   (chmod port
 257          (logand #o644
 258                  (lognot (umask))))
 259   (logand #x7f xyz))")
 260
 261 (test-pretty-print "\
 262 (substitute-keyword-arguments (package-arguments x)
 263   ((#:phases phases)
 264    `(modify-phases ,phases
 265       (add-before 'build 'do-things
 266         (lambda _
 267           #t))))
 268   ((#:configure-flags flags)
 269    `(cons \"--without-any-problem\"
 270           ,flags)))")
 271
 272 (test-pretty-print "\
 273 (vertical-space one:
 274
 275                 two:
 276
 277
 278                 three:
 279
 280
 281
 282                 end)")
 283
 284 (test-pretty-print "\
 285 (vertical-space one
 286
 287                 ;; Comment after blank line.
 288                 two)")
 289
 290 (test-pretty-print "\
 291 (begin
 292   break
 293 \f
 294   ;; page break above
 295   end)")
 296
 297 (test-pretty-print "\
 298 (home-environment
 299   (services
 300    (list (service-type home-bash-service-type))))")
 301
 302 (test-pretty-print/sequence "\
 303 ;;; This is a top-level comment.
 304
 305 \f
 306 ;; Above is a page break.
 307 (this is an sexp
 308       ;; with a comment
 309       !!)
 310
 311 ;; The end.\n")
 312
 313 (test-pretty-print/sequence "
 314 ;;; Hello!
 315 ;;; Notice that there are three semicolons here.
 316
 317 (define-module (foo bar)
 318   #:use-module (guix)
 319   #:use-module (gnu))
 320
 321
 322 ;; And now, the OS.
 323 (operating-system
 324   (host-name \"komputilo\")
 325   (locale \"eo_EO.UTF-8\")
 326
 327   (services
 328    (cons (service mcron-service-type) %base-services)))\n"
 329                             #:format-comment canonicalize-comment)
 330
 331 (test-equal "pretty-print-with-comments, canonicalize-comment"
 332   "\
 333 (list abc
 334       ;; Not a margin comment.
 335       ;; Ditto.
 336       ;;
 337       ;; There's a blank line above.
 338       def ;margin comment
 339       ghi)"
 340   (let ((sexp (call-with-input-string
 341                   "\
 342 (list abc
 343   ;Not a margin comment.
 344   ;;;  Ditto.
 345   ;;;;;
 346   ; There's a blank line above.
 347   def  ;; margin comment
 348   ghi)"
 349                 read-with-comments)))
 350     (call-with-output-string
 351       (lambda (port)
 352         (pretty-print-with-comments port sexp
 353                                     #:format-comment
 354                                     canonicalize-comment)))))
 355
 356 (test-equal "pretty-print-with-comments, canonicalize-vertical-space"
 357   "\
 358 (list abc
 359
 360       def
 361
 362       ;; last one
 363       ghi)"
 364   (let ((sexp (call-with-input-string
 365                   "\
 366 (list abc
 367
 368
 369
 370   def
 371
 372
 373 ;; last one
 374   ghi)"
 375                 read-with-comments)))
 376     (call-with-output-string
 377       (lambda (port)
 378         (pretty-print-with-comments port sexp
 379                                     #:format-vertical-space
 380                                     canonicalize-vertical-space)))))
 381
 382 (test-equal "pretty-print-with-comments, multi-line comment"
 383   "\
 384 (list abc
 385       ;; This comment spans
 386       ;; two lines.
 387       def)"
 388   (call-with-output-string
 389     (lambda (port)
 390       (pretty-print-with-comments port
 391                                   `(list abc ,(comment "\
 392 ;; This comment spans\n
 393 ;; two lines.\n")
 394                                          def)))))
 395
 396 (test-end)