;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2015, 2016, 2019 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 (test-build-utils)
  #:use-module (guix tests)
  #:use-module (guix build utils)
  #:use-module ((gnu build bootloader)
                #:select (invoke/quiet))
  #:use-module ((guix utils)
                #:select (%current-system call-with-temporary-directory))
  #:use-module (gnu packages)
  #:use-module (gnu packages bootstrap)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs io ports)
  #:use-module (ice-9 popen))


(test-begin "build-utils")

(test-equal "alist-cons-before"
  '((a . 1) (x . 42) (b . 2) (c . 3))
  (alist-cons-before 'b 'x 42 '((a . 1) (b . 2) (c . 3))))

(test-equal "alist-cons-before, reference not found"
  '((a . 1) (b . 2) (c . 3) (x . 42))
  (alist-cons-before 'z 'x 42 '((a . 1) (b . 2) (c . 3))))

(test-equal "alist-cons-after"
  '((a . 1) (b . 2) (x . 42) (c . 3))
  (alist-cons-after 'b 'x 42 '((a . 1) (b . 2) (c . 3))))

(test-equal "alist-cons-after, reference not found"
  '((a . 1) (b . 2) (c . 3) (x . 42))
  (alist-cons-after 'z 'x 42 '((a . 1) (b . 2) (c . 3))))

(test-equal "alist-replace"
  '((a . 1) (b . 77) (c . 3))
  (alist-replace 'b 77 '((a . 1) (b . 2) (c . 3))))

(test-assert "alist-replace, key not found"
  (not (false-if-exception
        (alist-replace 'z 77 '((a . 1) (b . 2) (c . 3))))))

(test-equal "fold-port-matches"
  (make-list 3 "Guix")
  (call-with-input-string "Guix is cool, Guix rocks, and it uses Guile, Guix!"
    (lambda (port)
      (fold-port-matches cons '() "Guix" port))))

(test-equal "fold-port-matches, trickier"
<tr><td><span title='2020-05-22 00:35:24 +0200'>2020-05-22</span></td><td><a href='/guix/commit/doc?id=0e4e9c8e7655f3e2a9c2615923768d211ac02a3e'>guix hash, guix download: Support base64 format.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2020-05-22 00:35:24 +0200'>2020-05-22</span></td><td><a href='/guix/commit/doc?id=18ae1ec3ecfe22d55d6cdf595a442afebbc5595a'>guix hash, guix download: Add '--hash'.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2020-05-22 00:35:23 +0200'>2020-05-22</span></td><td><a href='/guix/commit/doc?id=1ad5209d904d471ded6cf53b4e29b64e963dea3f'>maint: Add "make check-channel-news".</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2020-05-22 00:35:23 +0200'>2020-05-22</span></td><td><a href='/guix/commit/doc?id=5e46b827cf79c064372a99537e469505218def0a'>doc: Use "Alternatively" instead of "Alternately".</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2020-05-20 08:30:35 -0400'>2020-05-20</span></td><td><a href='/guix/commit/doc?id=b460ba7992a0b4af2ddb5927dcf062784539ef7b'>bootloader: grub: Allow booting from a Btrfs subvolume.</a><span class='msg-avail'>...</span></td><td>Maxim Cournoyer</td></tr>
<tr><td><span title='2020-05-20 08:30:34 -0400'>2020-05-20</span></td><td><a href='/guix/commit/doc?id=fa35fb58c84d1c1741e4e63c0b37074e35ed2a61'>file-systems: Add helpers for parsing the options string into an alist.</a><span class='msg-avail'>...</span></td><td>Maxim Cournoyer</td></tr>
<tr><td><span title='2020-05-20 08:30:34 -0400'>2020-05-20</span></td><td><a href='/guix/commit/doc?id=281d80d8e547fe663aaacb3226119166dd3100f9'>linux-boot: Refactor boot-system.</a><span class='msg-avail'>...</span></td><td>Maxim Cournoyer</td></tr>
<tr><td><span title='2020-05-18 15:08:58 +0200'>2020-05-18</span></td><td><a href='/guix/commit/doc?id=9a27d84b7a22188d3029199ad3f6dd3b8eccae70'>guix describe: Add '--list-formats'</a><span class='msg-avail'>...</span></td><td>Ekaitz Zarraga</td></tr>
<tr><td><span title='2020-05-18 15:08:58 +0200'>2020-05-18</span></td><td><a href='/guix/commit/doc?id=e5b495c18fb9ba3858b75c25659be65f7bd9b0da'>doc: Inherit md5.scm fix in custom 'guile-lib' variant.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
failure"
  (guard (c ((message-condition? c)
             (string-contains (condition-message c) "This is an error.")))
    (invoke/quiet "sh" "-c" "echo This is an error. ; false")
    #f))

(test-assert "invoke/quiet, failure, message on stderr"
  (guard (c ((message-condition? c)
             (string-contains (condition-message c)
                              "This is another error.")))
    (invoke/quiet "sh" "-c" "echo This is another error. >&2 ; false")
    #f))

(test-end)