;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021-2024, 2026 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 ((gcrypt hash) #:select (port-sha256))
  #:use-module (guix packages)
  #:use-module (guix read-print)
  #:use-module (guix scripts style)
  #:use-module ((guix utils)
                #:select (guile-version>?
                          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 (guix git)
  #:use-module (guix tests)
  #:use-module (guix tests git)
  #:use-module (gnu packages)
  #:use-module (gnu packages acl)
  #:use-module (gnu packages multiprecision)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 pretty-print)
  #:use-module (ice-9 vlist))

(define* (call-with-test-package inputs proc #:optional suffix)
  (let ((module-name (if suffix
                         (string-append "my-packages-" suffix)
                         "my-packages"))
        (name (if suffix
                  (string-append "my-coreutils-" suffix)
                  "my-coreutils")))
    (call-with-temporary-directory
     (lambda (directory)
       (call-with-output-file (string-append directory "/" module-name ".scm")
         (lambda (port)
           (pretty-print
            `(begin
               (define-module (,(string->symbol module-name))
                 #:use-module (guix)
                 #:use-module (guix git-download) ; for -S git-source
                 #:use-module ((gnu packages) #:select (search-patches))
                 #: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 ,(string->symbol name)
                 (package
                   (inherit base)
                   (name ,name)
                   ,@inputs
                   ;; XXX: The field below was added so that the 'inputs'
                   ;; field doesn't come last; if it did, 'read-package-field'
                   ;; in the tests below would read the three closing parens
                   ;; for each test.
                   (properties '()))))
            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))
         (absolute-file (if (string-prefix? "/" file)
                            file
                            (string-append (test-directory) "/"
                                           file)))
         (lines (call-with-input-file absolute-file
                  (lambda (port)
                    (read-lines port line count)))))
    (call-with-input-string lines read-with-comments/sequence)))


(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)))))
  (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))))
  (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) unbalanced))
  (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"
  '((inputs (list gmp acl (sdl-union 1 2 3 4))))
  (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))))
  (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)) unbalanced))
  (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)) unbalanced))
  (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)) unbalanced))
  (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)) unbalanced))
  (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))))
  (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, trivial arguments"
  (list `(("gmp" ,gmp) ("mpfr" ,mpfr))
        `((inputs (list gmp mpfr))))
  (call-with-test-package '((inputs `(("GMP" ,gmp) ("Mpfr" ,mpfr)))
                            (arguments            ;"trivial" arguments
                             '(#:tests? #f
                               #:test-target "whatever")))
    (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)))))
  (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)) ,(comment ";margin comment\n" #t))
        `((native-inputs (list acl)) ,(comment ";another one\n" #t)))
  (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 ,(comment ";margin comment\n" #t)
                acl
                gmp ,(comment ";margin comment\n" #t)
                acl
                gmp ,(comment ";margin comment\n" #t)
                acl
                gmp ,(comment ";margin comment\n" #t)
                acl)
          unbalanced))
  (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
                        ,(comment ";; line comment!\n")
                        acl))))
  (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 ,(comment ";margin comment\n" #t)
                     acl ,(comment ";another one\n" #t)
                     mpfr)) unbalanced))
  (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-assert "gexpify arguments, already gexpified"
  (call-with-test-package '((arguments
                             (list #:configure-flags #~'("--help"))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))
      (define (fingerprint file)
        (let ((stat (stat file)))
          (list (stat:mtime stat) (stat:size stat))))
      (define before
        (fingerprint file))

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

      (equal? (fingerprint file) before))))

(test-equal "gexpify arguments, non-gexp arguments, margin comment"
  (list (list #:tests? #f #:test-target "check")
        `((arguments (list #:tests? #f ,(comment ";no tests\n" #t)
                           #:test-target "check"))))
  (call-with-test-package '((arguments
                             '(#:tests? #f
                               #:test-target "check")))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (substitute* file
        (("#:tests\\? #f" all)
         (string-append all " ;no tests\n")))

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

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

(test-equal "gexpify arguments, phases and flags"
  `((list #:tests? #f
          #:configure-flags #~'("--fast")
          #:make-flags #~(list (string-append "CC=" #$(cc-for-target)))
          #:phases #~(modify-phases %standard-phases
                       ,(comment ";; Line comment.\n")
                       whatever))
    unbalanced)
  (call-with-test-package '((arguments
                             `(#:tests? #f
                               #:configure-flags '("--fast")
                               #:make-flags
                               (list (string-append "CC=" ,(cc-for-target)))
                               #:phases (modify-phases %standard-phases
                                          whatever))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (substitute* file
        (("whatever")
         "\n;; Line comment.
         whatever"))
      (system* "guix" "style" "-L" directory "my-coreutils"
               "-S" "arguments")

      (load file)
      (read-package-field (@ (my-packages) my-coreutils) 'arguments 7))))

(test-equal "gexpify arguments, append arguments"
  `((append (list #:tests? #f
                  #:configure-flags #~'("--fast"))
            (package-arguments coreutils)) unbalanced)
  (call-with-test-package '((arguments
                             `(#:tests? #f
                               #:configure-flags '("--fast")
                               ,@(package-arguments coreutils))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

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

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

(test-equal "gexpify arguments, substitute-keyword-arguments"
  `((substitute-keyword-arguments (package-arguments coreutils)
      ((#:tests? _ #f)
       #t)
      ((#:make-flags flags #~'())
       #~(cons "-DXYZ=yes" #$flags))) unbalanced)
  (call-with-test-package '((arguments
                             (substitute-keyword-arguments
                                 (package-arguments coreutils)
                               ((#:tests? _ #f) #t)
                               ((#:make-flags flags ''())
                                `(cons "-DXYZ=yes" ,flags)))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

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

      (load file)
      (read-package-field (@ (my-packages) my-coreutils) 'arguments 7))))

(test-equal "gexpify arguments, substitute-keyword-arguments + unquote-splicing"
  `((substitute-keyword-arguments (package-arguments coreutils)
      ((#:make-flags flags #~'())
       #~(cons "-DXYZ=yes" #$@(if #t flags '())))) unbalanced)
  (call-with-test-package '((arguments
                             (substitute-keyword-arguments
                                 (package-arguments coreutils)
                               ((#:make-flags flags ''())
                                `(cons "-DXYZ=yes" ,@(if #t flags '()))))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

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

      (load file)
      (read-package-field (@ (my-packages) my-coreutils) 'arguments 6))))

(test-equal "gexpify arguments, append substitute-keyword-arguments"
  `((append (list #:tests? #f)
            (substitute-keyword-arguments (package-arguments coreutils)
              ((#:make-flags flags)
               #~(append `("-n" ,%output) #$flags)))) unbalanced)
  (call-with-test-package '((arguments
                             `(#:tests? #f
                               ,@(substitute-keyword-arguments
                                     (package-arguments coreutils)
                                   ((#:make-flags flags)
                                    `(append `("-n" ,%output) ,flags))))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

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

      (load file)
      (read-package-field (@ (my-packages) my-coreutils) 'arguments 5))))

;;;
;;; url-fetch->git-fetch transformation
;;;

(test-equal "url-fetch->git-fetch, basic transformation"
  `((origin
      (method git-fetch)
      (uri (git-reference (url "https://github.com/foo/bar")
                          (commit version)))
      (file-name (git-file-name name version))
      (sha256
       (base32 "0j8vhvfj1d3jvbrd4kh20m50knmwj19xk0l3s78z1xxayp3c5zkk")))
    unbalanced
    (properties (quote ()))
    unbalanced unbalanced unbalanced)
  (call-with-test-package
      '((home-page "@substitute-me@")
        (version "1.0")
        (source
         (origin
           (method url-fetch)
           (uri (string-append "https://example.com/foo-" version ".tar.gz"))
           (sha256
            (base32 "0000000000000000000000000000000000000000000000000000")))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages-0.scm"))

      (parameterize ((test-directory directory))
        (with-temporary-git-repository repository
            `((add "README" "Initial commit")
              (commit "First commit")
              (tag "1.0" "Initial release"))
          (mock ((guix import utils) git-repository-url? (const #t))
                (substitute* file
                  (("@substitute-me@")
                   (string-append "file://" repository)))
                ;; XXX: Calling guix-style is necessary to use mock.
                (guix-style "-L" directory "-S" "git-source" "my-coreutils-0")
                (substitute* file
                  (((string-append "file://" repository))
                   "https://github.com/foo/bar"))

                (load file)
                (read-package-field (@ (my-packages-0) my-coreutils-0) 'source 8)))))
    "0"))

(test-equal "url-fetch->git-fetch, preserved field"
  `((origin
      (method git-fetch)
      (uri (git-reference
             (url "https://github.com/foo/bar")
             (commit version)))
      (file-name (git-file-name name version))
      (sha256
       (base32 "0j8vhvfj1d3jvbrd4kh20m50knmwj19xk0l3s78z1xxayp3c5zkk"))
      (patches (search-patches "foo.patch")))
    unbalanced
    (properties (quote ()))
    unbalanced unbalanced unbalanced)
  (call-with-test-package
      '((home-page "@substitute-me@")
        (version "1.0")
        (source
         (origin
           (method url-fetch)
           (uri "https://example.com/foo.tar.gz")
           (sha256
            (base32 "0000000000000000000000000000000000000000000000000000"))
           (patches (search-patches "foo.patch")))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages-1.scm"))
      (call-with-output-file (string-append directory "/foo.patch")
        (const #t))

      (parameterize ((test-directory directory))
        (with-temporary-git-repository repository
            `((add "README" "Initial commit")
              (commit "First commit")
              (tag "1.0" "Initial release"))
          (mock ((guix import utils) git-repository-url? (const #t))
                (mock ((gnu packages) specification->package+output
                       (lambda (spec)
                         (car
                          (vhash-fold* cons '() spec
                                       (fold-packages
                                        (lambda (p r)
                                          (vhash-cons (package-name p) p r))
                                        vlist-null)))))
                      (substitute* file
                        (("@substitute-me@")
                         (string-append "file://" repository)))
                      ;; XXX: Calling guix-style is necessary to use mock.
                      (guix-style "-L" directory "-S" "git-source" "my-coreutils-1")
                      (substitute* file
                        (((string-append "file://" repository))
                         "https://github.com/foo/bar"))
                      (load file)
                      (read-package-field
                       (@ (my-packages-1) my-coreutils-1) 'source 9))))))
    "1"))

(unless (false-if-exception
         (getaddrinfo "https.git.savannah.gnu.org" "https"))
  (test-skip 1))
(test-equal "url-fetch->git-fetch, mirror:// URL"
  '((origin
      (method git-fetch)
      (uri (git-reference
             (url "https://https.git.savannah.gnu.org/git/sed.git")
             (commit (string-append "v" version))))
      (file-name (git-file-name name version))
      (sha256
       (base32 "00p6v3aa22jz365scmifr06fspkylzrvbqda0waz4x06q5qv0263")))
    unbalanced
    (properties (quote ()))
    unbalanced unbalanced unbalanced)
  (call-with-test-package
      '((version "4.9")
        (source
         (origin
           (method url-fetch)
           (uri (string-append "mirror://gnu/sed/sed-"
                               version ".tar.gz"))
           (sha256
            (base32 "0000000000000000000000000000000000000000000000000000")))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages-1.scm"))

      ;; Note: This ends up cloning the 'sed' repository on Savannah.
      (system* "guix" "style" "-L" directory "-S" "git-source" "my-coreutils-1")

      (load file)
      (read-package-field (@ (my-packages-1) my-coreutils-1) 'source 8))
    "1"))

(test-assert "url-fetch->git-fetch, non-git home-page unchanged"
  (call-with-test-package
      '((home-page "https://www.example.com")
        (source
         (origin
           (method url-fetch)
           (uri "https://example.com/foo.tar.gz")
           (sha256
            (base32 "0000000000000000000000000000000000000000000000000000")))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))
      (define before-hash
        (call-with-input-file file port-sha256))

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

      ;; File should be unchanged
      (equal? (call-with-input-file file port-sha256) before-hash))))

(test-assert "url-fetch->git-fetch, already git-fetch unchanged"
  (call-with-test-package
      '((home-page "https://github.com/foo/bar")
        (source
         (origin
           (method git-fetch)
           (uri (git-reference
                  (url "https://github.com/foo/bar")
                  (commit version)))
           (file-name (git-file-name name version))
           (sha256
            (base32 "0000000000000000000000000000000000000000000000000000")))))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))
      (define before-hash
        (call-with-input-file file port-sha256))

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

      ;; File should be unchanged
      (equal? (call-with-input-file file port-sha256) before-hash))))


;;;
;;; remove-input, remove-native-input, remove-propagated-input
;;;

(test-equal "remove-input, single input removed"
  '((inputs (list)))
  (call-with-test-package '((inputs (list gmp)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-input" "--parameter=gmp"
               "my-coreutils")

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

(test-equal "remove-input, one of multiple inputs removed"
  `(("acl" ,acl))
  (call-with-test-package '((inputs (list gmp acl)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-input" "--parameter=gmp"
               "my-coreutils")

      (load file)
      (package-inputs (@ (my-packages) my-coreutils)))))

(test-equal "remove-input, middle input removed from list"
  `(("gmp" ,gmp) ("mpfr" ,mpfr))
  (call-with-test-package '((inputs (list gmp acl mpfr)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-input" "--parameter=acl"
               "my-coreutils")

      (load file)
      (package-inputs (@ (my-packages) my-coreutils)))))

(test-equal "remove-input, non-existent input unchanged"
  `(("gmp" ,gmp) ("acl" ,acl))
  (call-with-test-package '((inputs (list gmp acl)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-input" "--parameter=mpfr"
               "my-coreutils")

      (load file)
      (package-inputs (@ (my-packages) my-coreutils)))))

(test-equal "remove-input, input with output specifier"
  `(("acl" ,acl))
  (call-with-test-package '((inputs (list `(,gmp "debug") acl)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-input" "--parameter=gmp:debug"
               "my-coreutils")

      (load file)
      (package-inputs (@ (my-packages) my-coreutils)))))

;; (test-skip 100)

(test-equal "remove-native-input, single input removed"
  '()
  (call-with-test-package '((native-inputs (list gmp)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-native-input" "--parameter=gmp"
               "my-coreutils")

      (load file)
      (package-native-inputs (@ (my-packages) my-coreutils)))))

(test-equal "remove-native-input, one of multiple inputs removed"
  `(("acl" ,acl))
  (call-with-test-package '((native-inputs (list gmp acl)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-native-input" "--parameter=gmp"
               "my-coreutils")

      (load file)
      (package-native-inputs (@ (my-packages) my-coreutils)))))

(test-equal "remove-native-input, does not affect inputs field"
  `(("gmp" ,gmp))
  (call-with-test-package '((inputs (list gmp))
                            (native-inputs (list acl)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-native-input" "--parameter=acl"
               "my-coreutils")

      (load file)
      (package-inputs (@ (my-packages) my-coreutils)))))

(test-equal "remove-propagated-input, single input removed"
  '()
  (call-with-test-package '((propagated-inputs (list gmp)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-propagated-input" "--parameter=gmp"
               "my-coreutils")

      (load file)
      (package-propagated-inputs (@ (my-packages) my-coreutils)))))

(test-equal "remove-propagated-input, one of multiple inputs removed"
  `(("acl" ,acl))
  (call-with-test-package '((propagated-inputs (list gmp acl)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-propagated-input" "--parameter=gmp"
               "my-coreutils")

      (load file)
      (package-propagated-inputs (@ (my-packages) my-coreutils)))))

(test-equal "remove-propagated-input, does not affect other fields"
  (list `(("gmp" ,gmp)) `(("acl" ,acl)))
  (call-with-test-package '((inputs (list gmp))
                            (native-inputs (list acl))
                            (propagated-inputs (list mpfr)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-propagated-input" "--parameter=mpfr"
               "my-coreutils")

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

(test-equal "remove-input from all three fields independently"
  (list '() '() '())
  (call-with-test-package '((inputs (list gmp))
                            (native-inputs (list acl))
                            (propagated-inputs (list mpfr)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))

      (system* "guix" "style" "-L" directory
               "-S" "remove-input" "--parameter=gmp"
               "my-coreutils")
      (system* "guix" "style" "-L" directory
               "-S" "remove-native-input" "--parameter=acl"
               "my-coreutils")
      (system* "guix" "style" "-L" directory
               "-S" "remove-propagated-input" "--parameter=mpfr"
               "my-coreutils")

      (load file)
      (list (package-inputs (@ (my-packages) my-coreutils))
            (package-native-inputs (@ (my-packages) my-coreutils))
            (package-propagated-inputs (@ (my-packages) my-coreutils))))))

(test-assert "remove-input, dry-run does not modify file"
  (call-with-test-package '((inputs (list gmp acl)))
    (lambda (directory)
      (define file
        (string-append directory "/my-packages.scm"))
      (define before-hash
        (call-with-input-file file port-sha256))

      (system* "guix" "style" "-L" directory "-n"
               "-S" "remove-input" "--parameter=gmp"
               "my-coreutils")

      (equal? (call-with-input-file file port-sha256) before-hash))))

(test-end)

;; Local Variables:
;; eval: (put 'with-test-package 'scheme-indent-function 1)
;; eval: (put 'call-with-test-package 'scheme-indent-function 1)
;; End: