;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Mathieu Othacehe <othacehe@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 (gnu tests image)
  #:use-module (gnu)
  #:use-module (gnu image)
  #:use-module (gnu tests)
  #:autoload   (gnu system image) (system-image root-offset)
  #:use-module (gnu system uuid)
  #:use-</td></tr></table>
<table class='tabs'><tr><td>
<a class='active' href='/guix/about/'>about</a><a href='/guix/'>summary</a><a href='/guix/refs/?id=c8140c72306d071b822c3148105912ce760a7c74'>refs</a><a href='/guix/log/'>log</a><a href='/guix/tree/?id=c8140c72306d071b822c3148105912ce760a7c74'>tree</a><a href='/guix/commit/?id=c8140c72306d071b822c3148105912ce760a7c74'>commit</a><a href='/guix/diff/?id=c8140c72306d071b822c3148105912ce760a7c74'>diff</a></td><td class='form'><form class='right' method='get' action='/guix/log/'>
<input type='hidden' name='id' value='c8140c72306d071b822c3148105912ce760a7c74'/><select name='qt'>
<option value='grep'>log msg</option>
<option value='author'>author</option>
<option value='committer'>committer</option>
<option value='range'>range</option>
</select>
<input class='txt' type='search' size='10' name='q' value=''/>
<input type='submit' value='search'/>
</form>
</td></tr></table>
<div class='content'><div id='summary'><pre>
# GNU Guix --- Functional package management for GNU
# Copyright © 2019, 2020 Ludovic Courtès &lt;ludo@gnu.org&gt;
#
# 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 &lt;http://www.gnu.org/licenses/&gt;.

#
# Test the `guix package&apos; aliases.
#

guix install --version

readlink_base ()
{
    basename `readlink &quot;$1&quot;`
}

profile=&quot;t-profile-$$&quot;
rm -f &quot;$profile&quot;

trap &apos;rm -f &quot;$profile&quot; &quot;$profile-&quot;[0-9]*&apos; EXIT

guix install --bootstrap guile-bootstrap -p &quot;$profile&quot;
test -x &quot;$profile/bin/guile&quot;

# Make sure &apos;-r&apos; isn&apos;t passed as-is to &apos;guix package&apos;.
guix install -r guile-bootstrap -p &quot;$profile&quot; --bootstrap &amp;&amp; false
test -x &quot;$profile/bin/guile&quot;

# Use a package transformation option and make sure it&apos;s recorded.
guix install --bootstrap guile-bootstrap -p &quot;$profile&quot; \
     --with-input=libreoffice=inkscape
test -x &quot;$profile/bin/guile&quot;
grep &quot;libreoffice=inkscape&quot; &quot;$profile/manifest&quot;

guix upgrade --version
guix upgrade -n
guix upgrade gui.e -n
guix upgrade foo bar -n

guix remove --version
guix remove --bootstrap guile-bootstrap -p &quot;$profile&quot;
test ! -x &quot;$profile/bin/guile&quot;
test `guix package -p &quot;$profile&quot; -I | wc -l` -eq 0

guix remove -p &quot;$profile&quot; this-is-not-installed --bootstrap &amp;&amp; false

guix remove -i guile-bootstrap -p &quot;$profile&quot; --bootstrap &amp;&amp; false

guix search &apos;\&lt;board\&gt;&apos; game | grep &apos;^name: gnubg&apos;

guix show --version
guix show guile
guix show python@3 | grep &quot;^name: python&quot;

# &quot;python@2&quot; exists but is deprecated; make sure it doesn&apos;t show up.
guix show python@2 &amp;&amp; false

# Specifying multiple packages.
output=&quot;`guix show sed grep | grep ^name:`&quot;
test &quot;$output&quot; = &quot;name: sed
name: grep&quot;
</pre>
</div></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
     (disk-new (get-device img)))

            (test-runner-current (system-test-runner #$output))
            (test-begin "images")

            ;; Image i1.
            (define i1-image
              #$(system-image i1))
            (define d1-device
              (get-device i1-image))

            (test-equal "msdos"
              (disk-type-name (disk-probe d1-device)))

            (test-equal 1
              (disk-get-primary-partition-count (disk-new d1-device)))

            (test-assert
                (let* ((disk (disk-new d1-device))
                       (partitions (disk-partitions disk))
                       (boot-partition (find normal-partition? partitions)))
                  (partition-get-flag boot-partition PARTITION-FLAG-BOOT)))

            ;; Image i2.
            (define i2-image
              #$(system-image i2))
            (define d2-device
              (get-device i2-image))

            (test-equal "gpt"
              (disk-type-name (disk-probe d2-device)))

            (test-equal 1
              (disk-get-primary-partition-count (disk-new d2-device)))

            (test-equal "test"
                (let* ((disk (disk-new d2-device))
                       (partitions (disk-partitions disk))
                       (boot-partition (find normal-partition? partitions)))
                  (partition-get-name boot-partition)))

            ;; Image i3.
            (define i3-image
              #$(system-image i3))
            (define d3-device
              (get-device i3-image))

            (test-equal "msdos"
              (disk-type-name (disk-probe d3-device)))

            (test-equal 2
              (disk-get-primary-partition-count (disk-new d3-device)))

            ;; Image i4.
            (define i4-image
              #$(system-image i4))
            (define d4-device
              (get-device i4-image))

            (test-equal "gpt"
              (disk-type-name (disk-probe d4-device)))

            (test-equal 2
              (disk-get-primary-partition-count (disk-new d4-device)))

            ;; Image i5.
            (define i5-image
              #$(system-image i5))
            (define d5-device
              (get-device i5-image))

            (define (sector->byte sector)
              (/ (* sector (device-sector-size d5-device))
                 MEBIBYTE-SIZE))

            (test-equal "gpt"
              (disk-type-name (disk-probe d5-device)))

            (test-equal 2
              (disk-get-primary-partition-count (disk-new d5-device)))

            (test-equal '("fat32" "ext4")
              (map (compose filesystem-type-name partition-fs-type)
                   (filter data-partition?
                           (disk-partitions (disk-new d5-device)))))

            ;; The first partition has a 1MiB offset has a 128MiB size. The
            ;; second partition should then start at 129MiB.
            (test-equal '(1 129)
              (map (compose sector->byte partition-start)
                   (filter data-partition?
                           (disk-partitions (disk-new d5-device)))))

            (test-end)))))

  (gexp->derivation "images-test" test))

(define %test-images
  (system-test
   (name "images")
   (description "Build and test basic system images.")
   (value (run-images-test))))