[jackhill/guix/guix.git] / tests / style.scm

;;; 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 packages)
  #:use-module (guix scripts style)
  #:use-module ((guix utils) #:select (call-with-temporary-directory))
  #:use-module ((guix build utils) #:select (substitute*))
  #:use-module (guix gexp)                        ;for the reader extension
  #:use-module (guix diagnostics)
  #:use-module (gnu packages acl)
  #:use-module (gnu packages multiprecision)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 pretty-print))

(define (call-with-test-package inputs proc)
  (call-with-temporary-directory
   (lambda (directory)
     (call-with-output-file (string-append directory "/my-packages.scm")
       (lambda (port)
         (pretty-print
          `(begin
             (define-module (my-packages)
               #:use-module (guix)
               #:use-module (guix licenses)
               #:use-module (gnu packages acl)
               #:use-module (gnu packages base)
               #:use-module (gnu packages multiprecision)
               #:use-module (srfi srfi-1))

             (define base
               (package
                 (inherit coreutils)
                 (inputs '())
                 (native-inputs '())
                 (propagated-inputs '())))

             (define (sdl-union . lst)
               (package
                 (inherit base)
                 (name "sdl-union")))

             (define-public my-coreutils
               (package
                 (inherit base)
                 ,@inputs
                 (name "my-coreutils"))))
          port)))

     (proc directory))))

(define test-directory
  ;; Directory where the package definition lives.
  (make-parameter #f))

(define-syntax-rule (with-test-package fields exp ...)
  (call-with-test-package fields
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      ;; Run as a separate process to make sure FILE is reloaded.
      (system* "guix" "style" "-L" directory "-S" "inputs"
               "my-coreutils")
      (system* "cat" file)

      (load file)
      (parameterize ((test-directory directory))
        exp ...))))

(define* (read-lines port line #:optional (count 1))
  "Read COUNT lines from PORT, starting from LINE."
  (let loop ((lines '())
             (count count))
    (cond ((< (port-line port) (- line 1))
           (read-char port)
           (loop lines count))
          ((zero? count)
           (string-concatenate-reverse lines))
          (else
           (match (read-line port 'concat)
             ((? eof-object?)
              (loop lines 0))
             (line
              (loop (cons line lines) (- count 1))))))))

(define* (read-package-field package field #:optional (count 1))
  (let* ((location (package-field-location package field))
         (file (location-file location))
         (line (location-line location)))
    (call-with-input-file (if (string-prefix? "/" file)
                              file
                              (string-append (test-directory) "/"
                                             file))
      (lambda (port)
        (read-lines port line count)))))

\f
(test-begin "style")

(test-equal "nothing to rewrite"
  '()
  (with-test-package '()
    (package-direct-inputs (@ (my-packages) my-coreutils))))

(test-equal "input labels, mismatch"
  (list `(("foo" ,gmp) ("bar" ,acl))
        "      (inputs `((\"foo\" ,gmp) (\"bar\" ,acl)))\n")
  (with-test-package '((inputs `(("foo" ,gmp) ("bar" ,acl))))
    (list (package-direct-inputs (@ (my-packages) my-coreutils))
          (read-package-field (@ (my-packages) my-coreutils) 'inputs))))

(test-equal "input labels, simple"
  (list `(("gmp" ,gmp) ("acl" ,acl))
        "      (inputs (list gmp acl))\n")
  (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
    (list (package-direct-inputs (@ (my-packages) my-coreutils))
          (read-package-field (@ (my-packages) my-coreutils) 'inputs))))

(test-equal "input labels, long list with one item per line"
  (list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
        "\
        (list gmp
              acl
              gmp
              acl
              gmp
              acl
              gmp
              acl))\n")
  (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
                                 ("gmp" ,gmp) ("acl" ,acl)
                                 ("gmp" ,gmp) ("acl" ,acl)
                                 ("gmp" ,gmp) ("acl" ,acl))))
    (list (package-direct-inputs (@ (my-packages) my-coreutils))
          (read-package-field (@ (my-packages) my-coreutils) 'inputs 8))))

(test-equal "input labels, sdl-union"
  "\
        (list gmp acl
              (sdl-union 1 2 3 4)))\n"
  (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
                                 ("sdl-union" ,(sdl-union 1 2 3 4)))))
    (read-package-field (@ (my-packages) my-coreutils) 'inputs 2)))

(test-equal "input labels, output"
  (list `(("gmp" ,gmp "debug") ("acl" ,acl))
        "      (inputs (list `(,gmp \"debug\") acl))\n")
  (with-test-package '((inputs `(("gmp" ,gmp "debug") ("acl" ,acl))))
    (list (package-direct-inputs (@ (my-packages) my-coreutils))
          (read-package-field (@ (my-packages) my-coreutils) 'inputs))))

(test-equal "input labels, prepend"
  (list `(("gmp" ,gmp) ("acl" ,acl))
        "\
        (modify-inputs (package-propagated-inputs coreutils)
          (prepend gmp acl)))\n")
  (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
                                 ,@(package-propagated-inputs coreutils))))
    (list (package-inputs (@ (my-packages) my-coreutils))
          (read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))

(test-equal "input labels, prepend + delete"
  (list `(("gmp" ,gmp) ("acl" ,acl))
        "\
        (modify-inputs (package-propagated-inputs coreutils)
          (delete \"gmp\")
          (prepend gmp acl)))\n")
  (with-test-package '((inputs `(("gmp" ,gmp)
                                 ("acl" ,acl)
                                 ,@(alist-delete "gmp"
                                                 (package-propagated-inputs coreutils)))))
    (list (package-inputs (@ (my-packages) my-coreutils))
          (read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))

(test-equal "input labels, prepend + delete multiple"
  (list `(("gmp" ,gmp) ("acl" ,acl))
        "\
        (modify-inputs (package-propagated-inputs coreutils)
          (delete \"foo\" \"bar\" \"baz\")
          (prepend gmp acl)))\n")
  (with-test-package '((inputs `(("gmp" ,gmp)
                                 ("acl" ,acl)
                                 ,@(fold alist-delete
                                         (package-propagated-inputs coreutils)
                                         '("foo" "bar" "baz")))))
    (list (package-inputs (@ (my-packages) my-coreutils))
          (read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))

(test-equal "input labels, replace"
  (list '()                                 ;there's no "gmp" input to replace
        "\
        (modify-inputs (package-propagated-inputs coreutils)
          (replace \"gmp\" gmp)))\n")
  (with-test-package '((inputs `(("gmp" ,gmp)
                                 ,@(alist-delete "gmp"
                                                 (package-propagated-inputs coreutils)))))
    (list (package-inputs (@ (my-packages) my-coreutils))
          (read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))

(test-equal "input labels, 'safe' policy"
  (list `(("gmp" ,gmp) ("acl" ,acl))
        "\
      (inputs (list gmp acl))\n")
  (call-with-test-package '((inputs `(("GMP" ,gmp) ("ACL" ,acl)))
                            (arguments '()))      ;no build system arguments
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory "my-coreutils"
               "-S" "inputs"
               "--input-simplification=safe")

      (load file)
      (list (package-inputs (@ (my-packages) my-coreutils))
            (read-package-field (@ (my-packages) my-coreutils) 'inputs)))))

(test-equal "input labels, 'safe' policy, nothing changed"
  (list `(("GMP" ,gmp) ("ACL" ,acl))
        "\
      (inputs `((\"GMP\" ,gmp) (\"ACL\" ,acl)))\n")
  (call-with-test-package '((inputs `(("GMP" ,gmp) ("ACL" ,acl)))
                            ;; Non-empty argument list, so potentially unsafe
                            ;; input simplification.
                            (arguments
                             '(#:configure-flags
                               (assoc-ref %build-inputs "GMP"))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory "my-coreutils"
               "-S" "inputs"
               "--input-simplification=safe")

      (load file)
      (list (package-inputs (@ (my-packages) my-coreutils))
            (read-package-field (@ (my-packages) my-coreutils) 'inputs)))))

(test-equal "input labels, margin comment"
  (list `(("gmp" ,gmp))
        `(("acl" ,acl))
        "      (inputs (list gmp)) ;margin comment\n"
        "      (native-inputs (list acl)) ;another one\n")
  (call-with-test-package '((inputs `(("gmp" ,gmp)))
                            (native-inputs `(("acl" ,acl))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (substitute* file
        (("\"gmp\"(.*)$" _ rest)
         (string-append "\"gmp\"" (string-trim-right rest)
                        " ;margin comment\n"))
        (("\"acl\"(.*)$" _ rest)
         (string-append "\"acl\"" (string-trim-right rest)
                        " ;another one\n")))
      (system* "cat" file)

      (system* "guix" "style" "-L" directory "-S" "inputs"
               "my-coreutils")

      (load file)
      (list (package-inputs (@ (my-packages) my-coreutils))
            (package-native-inputs (@ (my-packages) my-coreutils))
            (read-package-field (@ (my-packages) my-coreutils) 'inputs)
            (read-package-field (@ (my-packages) my-coreutils) 'native-inputs)))))

(test-equal "input labels, margin comment on long list"
  (list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
        "\
        (list gmp ;margin comment
              acl
              gmp ;margin comment
              acl
              gmp ;margin comment
              acl
              gmp ;margin comment
              acl))\n")
  (call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
                                      ("gmp" ,gmp) ("acl" ,acl)
                                      ("gmp" ,gmp) ("acl" ,acl)
                                      ("gmp" ,gmp) ("acl" ,acl))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (substitute* file
        (("\"gmp\"(.*)$" _ rest)
         (string-append "\"gmp\"" (string-trim-right rest)
                        " ;margin comment\n")))
      (system* "cat" file)

      (system* "guix" "style" "-L" directory "-S" "inputs"
               "my-coreutils")

      (load file)
      (list (package-inputs (@ (my-packages) my-coreutils))
            (read-package-field (@ (my-packages) my-coreutils) 'inputs 8)))))

(test-equal "input labels, line comment"
  (list `(("gmp" ,gmp) ("acl" ,acl))
        "\
      (inputs (list gmp
                    ;; line comment!
                    acl))\n")
  (call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (substitute* file
        ((",gmp\\)(.*)$" _ rest)
         (string-append ",gmp)\n   ;; line comment!\n" rest)))

      (system* "guix" "style" "-L" directory "-S" "inputs"
               "my-coreutils")

      (load file)
      (list (package-inputs (@ (my-packages) my-coreutils))
            (read-package-field (@ (my-packages) my-coreutils) 'inputs 3)))))

(test-equal "input labels, modify-inputs and margin comment"
  (list `(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr))
        "\
        (modify-inputs (package-propagated-inputs coreutils)
          (prepend gmp ;margin comment
                   acl ;another one
                   mpfr)))\n")
  (call-with-test-package '((inputs
                             `(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr)
                               ,@(package-propagated-inputs coreutils))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (substitute* file
        ((",gmp\\)(.*)$" _ rest)
         (string-append ",gmp) ;margin comment" rest))
        ((",acl\\)(.*)$" _ rest)
         (string-append ",acl) ;another one" rest)))

      (system* "guix" "style" "-L" directory "-S" "inputs"
               "my-coreutils")

      (load file)
      (list (package-inputs (@ (my-packages) my-coreutils))
            (read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))


(test-end)

;; Local Variables:
;; eval: (put 'with-test-package 'scheme-indent-function 1)
;; eval: (put 'call-with-test-package 'scheme-indent-function 1)
;; End:
Commit	Line	Data
f23803af	1	;;; GNU Guix --- Functional package management for GNU
c9cded09	2	;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
f23803af LC	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 packages)
	21	#:use-module (guix scripts style)
	22	#:use-module ((guix utils) #:select (call-with-temporary-directory))
	23	#:use-module ((guix build utils) #:select (substitute*))
97d0055e	24	#:use-module (guix gexp) ;for the reader extension
f23803af LC	25	#:use-module (guix diagnostics)
	26	#:use-module (gnu packages acl)
	27	#:use-module (gnu packages multiprecision)
	28	#:use-module (srfi srfi-1)
	29	#:use-module (srfi srfi-64)
	30	#:use-module (ice-9 match)
	31	#:use-module (ice-9 rdelim)
	32	#:use-module (ice-9 pretty-print))
	33
	34	(define (call-with-test-package inputs proc)
	35	(call-with-temporary-directory
	36	(lambda (directory)
	37	(call-with-output-file (string-append directory "/my-packages.scm")
	38	(lambda (port)
	39	(pretty-print
	40	`(begin
	41	(define-module (my-packages)
	42	#:use-module (guix)
	43	#:use-module (guix licenses)
	44	#:use-module (gnu packages acl)
	45	#:use-module (gnu packages base)
	46	#:use-module (gnu packages multiprecision)
	47	#:use-module (srfi srfi-1))
	48
	49	(define base
	50	(package
	51	(inherit coreutils)
	52	(inputs '())
	53	(native-inputs '())
	54	(propagated-inputs '())))
	55
	56	(define (sdl-union . lst)
	57	(package
	58	(inherit base)
	59	(name "sdl-union")))
	60
	61	(define-public my-coreutils
	62	(package
	63	(inherit base)
	64	,@inputs
	65	(name "my-coreutils"))))
	66	port)))
	67
	68	(proc directory))))
	69
	70	(define test-directory
	71	;; Directory where the package definition lives.
	72	(make-parameter #f))
	73
	74	(define-syntax-rule (with-test-package fields exp ...)
	75	(call-with-test-package fields
	76	(lambda (directory)
	77	(define file
	78	(string-append directory "/my-packages.scm"))
	79
	80	;; Run as a separate process to make sure FILE is reloaded.
c4fe13c2 LC	81	(system* "guix" "style" "-L" directory "-S" "inputs"
c4fe13c2 LC	82	"my-coreutils")
f23803af LC	83	(system* "cat" file)
	84
	85	(load file)
	86	(parameterize ((test-directory directory))
	87	exp ...))))
	88
	89	(define* (read-lines port line #:optional (count 1))
	90	"Read COUNT lines from PORT, starting from LINE."
	91	(let loop ((lines '())
	92	(count count))
	93	(cond ((< (port-line port) (- line 1))
	94	(read-char port)
	95	(loop lines count))
	96	((zero? count)
	97	(string-concatenate-reverse lines))
	98	(else
	99	(match (read-line port 'concat)
	100	((? eof-object?)
	101	(loop lines 0))
	102	(line
	103	(loop (cons line lines) (- count 1))))))))
	104
	105	(define* (read-package-field package field #:optional (count 1))
	106	(let* ((location (package-field-location package field))
	107	(file (location-file location))
	108	(line (location-line location)))
	109	(call-with-input-file (if (string-prefix? "/" file)
	110	file
	111	(string-append (test-directory) "/"
	112	file))
	113	(lambda (port)
	114	(read-lines port line count)))))
	115
	116	\f
	117	(test-begin "style")
	118
	119	(test-equal "nothing to rewrite"
	120	'()
	121	(with-test-package '()
	122	(package-direct-inputs (@ (my-packages) my-coreutils))))
	123
	124	(test-equal "input labels, mismatch"
	125	(list `(("foo" ,gmp) ("bar" ,acl))
	126	" (inputs `((\"foo\" ,gmp) (\"bar\" ,acl)))\n")
	127	(with-test-package '((inputs `(("foo" ,gmp) ("bar" ,acl))))
	128	(list (package-direct-inputs (@ (my-packages) my-coreutils))
	129	(read-package-field (@ (my-packages) my-coreutils) 'inputs))))
	130
	131	(test-equal "input labels, simple"
	132	(list `(("gmp" ,gmp) ("acl" ,acl))
	133	" (inputs (list gmp acl))\n")
	134	(with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
	135	(list (package-direct-inputs (@ (my-packages) my-coreutils))
	136	(read-package-field (@ (my-packages) my-coreutils) 'inputs))))
	137
	138	(test-equal "input labels, long list with one item per line"
	139	(list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
	140	"\
	141	(list gmp
	142	acl
	143	gmp
	144	acl
	145	gmp
	146	acl
147	gmp
148	acl))\n")
149	(with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
150	("gmp" ,gmp) ("acl" ,acl)
151	("gmp" ,gmp) ("acl" ,acl)
152	("gmp" ,gmp) ("acl" ,acl))))
153	(list (package-direct-inputs (@ (my-packages) my-coreutils))
154	(read-package-field (@ (my-packages) my-coreutils) 'inputs 8))))
155
156	(test-equal "input labels, sdl-union"
157	"\
158	(list gmp acl
159	(sdl-union 1 2 3 4)))\n"
160	(with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
161	("sdl-union" ,(sdl-union 1 2 3 4)))))
162	(read-package-field (@ (my-packages) my-coreutils) 'inputs 2)))
163
164	(test-equal "input labels, output"
165	(list `(("gmp" ,gmp "debug") ("acl" ,acl))
166	" (inputs (list `(,gmp \"debug\") acl))\n")
167	(with-test-package '((inputs `(("gmp" ,gmp "debug") ("acl" ,acl))))
168	(list (package-direct-inputs (@ (my-packages) my-coreutils))
169	(read-package-field (@ (my-packages) my-coreutils) 'inputs))))
170
171	(test-equal "input labels, prepend"
172	(list `(("gmp" ,gmp) ("acl" ,acl))
173	"\
174	(modify-inputs (package-propagated-inputs coreutils)
175	(prepend gmp acl)))\n")
176	(with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
177	,@(package-propagated-inputs coreutils))))
178	(list (package-inputs (@ (my-packages) my-coreutils))
179	(read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))
180
181	(test-equal "input labels, prepend + delete"
182	(list `(("gmp" ,gmp) ("acl" ,acl))
183	"\
184	(modify-inputs (package-propagated-inputs coreutils)
185	(delete \"gmp\")
186	(prepend gmp acl)))\n")
187	(with-test-package '((inputs `(("gmp" ,gmp)
188	("acl" ,acl)
189	,@(alist-delete "gmp"
190	(package-propagated-inputs coreutils)))))
191	(list (package-inputs (@ (my-packages) my-coreutils))
192	(read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))
193
194	(test-equal "input labels, prepend + delete multiple"
195	(list `(("gmp" ,gmp) ("acl" ,acl))
196	"\
197	(modify-inputs (package-propagated-inputs coreutils)
198	(delete \"foo\" \"bar\" \"baz\")
199	(prepend gmp acl)))\n")
200	(with-test-package '((inputs `(("gmp" ,gmp)
201	("acl" ,acl)
202	,@(fold alist-delete
203	(package-propagated-inputs coreutils)
204	'("foo" "bar" "baz")))))
205	(list (package-inputs (@ (my-packages) my-coreutils))
206	(read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))
207
208	(test-equal "input labels, replace"
209	(list '() ;there's no "gmp" input to replace
210	"\
211	(modify-inputs (package-propagated-inputs coreutils)
212	(replace \"gmp\" gmp)))\n")
213	(with-test-package '((inputs `(("gmp" ,gmp)
214	,@(alist-delete "gmp"
215	(package-propagated-inputs coreutils)))))
216	(list (package-inputs (@ (my-packages) my-coreutils))
217	(read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))
218
219	(test-equal "input labels, 'safe' policy"
220	(list `(("gmp" ,gmp) ("acl" ,acl))
221	"\
222	(inputs (list gmp acl))\n")
223	(call-with-test-package '((inputs `(("GMP" ,gmp) ("ACL" ,acl)))
224	(arguments '())) ;no build system arguments
225	(lambda (directory)
226	(define file
227	(string-append directory "/my-packages.scm"))
228
229	(system* "guix" "style" "-L" directory "my-coreutils"
c4fe13c2	230	"-S" "inputs"
f23803af LC	231	"--input-simplification=safe")
	232
	233	(load file)
	234	(list (package-inputs (@ (my-packages) my-coreutils))
	235	(read-package-field (@ (my-packages) my-coreutils) 'inputs)))))
	236
	237	(test-equal "input labels, 'safe' policy, nothing changed"
	238	(list `(("GMP" ,gmp) ("ACL" ,acl))
	239	"\
	240	(inputs `((\"GMP\" ,gmp) (\"ACL\" ,acl)))\n")
	241	(call-with-test-package '((inputs `(("GMP" ,gmp) ("ACL" ,acl)))
	242	;; Non-empty argument list, so potentially unsafe
	243	;; input simplification.
	244	(arguments
	245	'(#:configure-flags
	246	(assoc-ref %build-inputs "GMP"))))
	247	(lambda (directory)
	248	(define file
	249	(string-append directory "/my-packages.scm"))
	250
	251	(system* "guix" "style" "-L" directory "my-coreutils"
c4fe13c2	252	"-S" "inputs"
f23803af LC	253	"--input-simplification=safe")
	254
	255	(load file)
	256	(list (package-inputs (@ (my-packages) my-coreutils))
	257	(read-package-field (@ (my-packages) my-coreutils) 'inputs)))))
	258
	259	(test-equal "input labels, margin comment"
	260	(list `(("gmp" ,gmp))
	261	`(("acl" ,acl))
	262	" (inputs (list gmp)) ;margin comment\n"
	263	" (native-inputs (list acl)) ;another one\n")
	264	(call-with-test-package '((inputs `(("gmp" ,gmp)))
	265	(native-inputs `(("acl" ,acl))))
	266	(lambda (directory)
	267	(define file
	268	(string-append directory "/my-packages.scm"))
	269
	270	(substitute* file
	271	(("\"gmp\"(.*)$" _ rest)
	272	(string-append "\"gmp\"" (string-trim-right rest)
	273	" ;margin comment\n"))
	274	(("\"acl\"(.*)$" _ rest)
	275	(string-append "\"acl\"" (string-trim-right rest)
	276	" ;another one\n")))
	277	(system* "cat" file)
	278
c4fe13c2 LC	279	(system* "guix" "style" "-L" directory "-S" "inputs"
c4fe13c2 LC	280	"my-coreutils")
f23803af LC	281
	282	(load file)
	283	(list (package-inputs (@ (my-packages) my-coreutils))
	284	(package-native-inputs (@ (my-packages) my-coreutils))
	285	(read-package-field (@ (my-packages) my-coreutils) 'inputs)
	286	(read-package-field (@ (my-packages) my-coreutils) 'native-inputs)))))
	287
	288	(test-equal "input labels, margin comment on long list"
	289	(list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
	290	"\
	291	(list gmp ;margin comment
	292	acl
	293	gmp ;margin comment
	294	acl
	295	gmp ;margin comment
	296	acl
	297	gmp ;margin comment
	298	acl))\n")
	299	(call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
	300	("gmp" ,gmp) ("acl" ,acl)
	301	("gmp" ,gmp) ("acl" ,acl)
	302	("gmp" ,gmp) ("acl" ,acl))))
	303	(lambda (directory)
	304	(define file
	305	(string-append directory "/my-packages.scm"))
	306
	307	(substitute* file
	308	(("\"gmp\"(.*)$" _ rest)
	309	(string-append "\"gmp\"" (string-trim-right rest)
	310	" ;margin comment\n")))
	311	(system* "cat" file)
	312
c4fe13c2 LC	313	(system* "guix" "style" "-L" directory "-S" "inputs"
c4fe13c2 LC	314	"my-coreutils")
f23803af LC	315
	316	(load file)
	317	(list (package-inputs (@ (my-packages) my-coreutils))
	318	(read-package-field (@ (my-packages) my-coreutils) 'inputs 8)))))
	319
	320	(test-equal "input labels, line comment"
	321	(list `(("gmp" ,gmp) ("acl" ,acl))
	322	"\
	323	(inputs (list gmp
	324	;; line comment!
	325	acl))\n")
	326	(call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
	327	(lambda (directory)
	328	(define file
	329	(string-append directory "/my-packages.scm"))
	330
	331	(substitute* file
	332	((",gmp\\)(.*)$" _ rest)
	333	(string-append ",gmp)\n ;; line comment!\n" rest)))
	334
c4fe13c2 LC	335	(system* "guix" "style" "-L" directory "-S" "inputs"
c4fe13c2 LC	336	"my-coreutils")
f23803af LC	337
	338	(load file)
	339	(list (package-inputs (@ (my-packages) my-coreutils))
	340	(read-package-field (@ (my-packages) my-coreutils) 'inputs 3)))))
	341
	342	(test-equal "input labels, modify-inputs and margin comment"
	343	(list `(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr))
	344	"\
	345	(modify-inputs (package-propagated-inputs coreutils)
	346	(prepend gmp ;margin comment
	347	acl ;another one
	348	mpfr)))\n")
	349	(call-with-test-package '((inputs
	350	`(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr)
	351	,@(package-propagated-inputs coreutils))))
	352	(lambda (directory)
	353	(define file
	354	(string-append directory "/my-packages.scm"))
	355
	356	(substitute* file
	357	((",gmp\\)(.*)$" _ rest)
3eb3901d	358	(string-append ",gmp) ;margin comment" rest))
f23803af	359	((",acl\\)(.*)$" _ rest)
3eb3901d	360	(string-append ",acl) ;another one" rest)))
f23803af	361
c4fe13c2 LC	362	(system* "guix" "style" "-L" directory "-S" "inputs"
c4fe13c2 LC	363	"my-coreutils")
f23803af LC	364
	365	(load file)
	366	(list (package-inputs (@ (my-packages) my-coreutils))
	367	(read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
	368
5d9a5e23	369
f23803af LC	370	(test-end)
	371
	372	;; Local Variables:
	373	;; eval: (put 'with-test-package 'scheme-indent-function 1)
	374	;; eval: (put 'call-with-test-package 'scheme-indent-function 1)
	375	;; End: