;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 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-ui)
  #:use-module (guix ui)
  #:use-module (guix profiles)
  #:use-module (guix store)
  #:use-module (guix derivations)
  #:use-module ((gnu packages) #:select (specification->package))
  </td></tr></table>
<table class='tabs'><tr><td>
<a href='/guix/about/'>about</a><a href='/guix/'>summary</a><a href='/guix/refs/?id=6b05cfb4e47c28d3432d01d58ae4157d816d9d67'>refs</a><a href='/guix/log/hydra.gnu.org.pub'>log</a><a class='active' href='/guix/tree/hydra.gnu.org.pub?id=6b05cfb4e47c28d3432d01d58ae4157d816d9d67'>tree</a><a href='/guix/commit/hydra.gnu.org.pub?id=6b05cfb4e47c28d3432d01d58ae4157d816d9d67'>commit</a><a href='/guix/diff/hydra.gnu.org.pub?id=6b05cfb4e47c28d3432d01d58ae4157d816d9d67'>diff</a></td><td class='form'><form class='right' method='get' action='/guix/log/hydra.gnu.org.pub'>
<input type='hidden' name='id' value='6b05cfb4e47c28d3432d01d58ae4157d816d9d67'/><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='path'>path: <a href='/guix/tree/?id=6b05cfb4e47c28d3432d01d58ae4157d816d9d67'>root</a>/<a href='/guix/tree/hydra.gnu.org.pub?id=6b05cfb4e47c28d3432d01d58ae4157d816d9d67'>hydra.gnu.org.pub</a></div><div class='content'>blob: 6db597ed4d05e9b615e0d8bc95a84cdef904a564 (<a href='/guix/about/hydra.gnu.org.pub?id=6b05cfb4e47c28d3432d01d58ae4157d816d9d67'>about</a>) (<a href='/guix/plain/hydra.gnu.org.pub?id=6b05cfb4e47c28d3432d01d58ae4157d816d9d67'>plain</a>)
<table summary='blob content' class='blob'>
<tr><td class='linenumbers'><pre><a id='n1' href='#n1'>1</a>
<a id='n2' href='#n2'>2</a>
<a id='n3' href='#n3'>3</a>
<a id='n4' href='#n4'>4</a>
<a id='n5' href='#n5'>5</a>
<a id='n6' href='#n6'>6</a>
</pre></td>
<td class='lines'><pre><code> (public-key 
  (rsa 
   (n #00DB1634E3D9DFAC97AE4734DAE968CCB15EE4815C82BDC254883DBB49FE1EF32268E82D4BBE0E35298C481C9DA1551642FAFF05AEC1A60712F1BB4BE7D25D7EFF7A4F89704A5A9AC232870CB9F2476C3B538A0E990A8825DEB73081D317001FB8A188600F2FEF5F5F570E857F3EE4355077A3C3918ED72723A56BA55C466D400658974D7DAD1F6B7B63C192B9C2704D98BBFF1C3BD5B8EF11A8ADC83ACB8FD8E9F1E792FDAD262415D13F2DEE55F330908CFDA9C3C8C32B64F7DD088457D34F445E2E2C83C6D680549DC9B6E6573B89496567204ED285E67A279F2F667080BA941D80D015CE87B0FB6A91A99CECC7D91D2D210B00E4B6E611DA51DB008F1DFE3FCAC6B27393FA781D45F9A15FC7B8785A3E86BA6592B2916CA22CF1E40FC85F85CACA590461154F58F3580B16398908EF32076F411299C28727C94D88B6A618F84DD73AEBED8270BCB6690928CB1BF250C35E1F6BF3B1B30D05BA246ECE8F69D9065DE26F4B3E0D814D70A9C27CB5B7B050C9090590D3A9EF83374F2643E5446FBD39DDB124DBF6DFDAA6D18E2560AD0CBFA11C959C9B7316BF19963A191967054E9FD97DC14D71082B30B1C90A46E8996682474C3BCB51BA0882958897B6DD35E41B5174D0A6BCDE97B89043E95BD1B70DE61DA666893B417196A180005466BC3A742FDF04E89B04460E3E6BC72E7F1B5FEA5B3092FEE551A3C447C12E104E65#)
   (e #010001#)
   )
  )
</code></pre></td></tr></table>
</div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
(string->generations "3..3"))

(test-equal "indefinite end range"
  '(>= 7)
  (string->generations "7.."))

(test-equal "indefinite start range"
  '(<= 42)
  (string->generations "..42"))

(test-equal "integer, char"
  #f
  (string->generations "a"))

(test-equal "comma-separated integers, consecutive comma"
  #f
  (string->generations "1,,2"))

(test-equal "comma-separated integers, trailing comma"
  #f
  (string->generations "1,2,"))

(test-equal "comma-separated integers, chars"
  #f
  (string->generations "a,b"))

(test-equal "closed range, start > end"
  #f
  (string->generations "9..2"))

(test-equal "closed range, chars"
  #f
  (string->generations "a..b"))

(test-equal "indefinite end range, char"
  #f
  (string->generations "a.."))

(test-equal "indefinite start range, char"
  #f
  (string->generations "..a"))

(test-equal "duration, 1 day"
  (make-time time-duration 0 (* 3600 24))
  (string->duration "1d"))

(test-equal "duration, 1 week"
  (make-time time-duration 0 (* 3600 24 7))
  (string->duration "1w"))

(test-equal "duration, 1 month"
  (make-time time-duration 0 (* 3600 24 30))
  (string->duration "1m"))

(test-equal "duration, 1 week == 7 days"
  (string->duration "1w")
  (string->duration "7d"))

(test-equal "duration, 1 month == 30 days"
  (string->duration "1m")
  (string->duration "30d"))

(test-equal "duration, 2 hours"
  7200
  (time-second (string->duration "2h")))

(test-equal "duration, 1 second"
  (make-time time-duration 0 1)
  (string->duration "1s"))

(test-equal "duration, integer"
  #f
  (string->duration "1"))

(test-equal "duration, char"
  #f
  (string->duration "d"))

(test-equal "size->number, bytes"
  42
  (size->number "42"))

(test-equal "size->number, MiB"
  (* 42 (expt 2 20))
  (size->number "42MiB"))

(test-equal "size->number, GiB"
  (* 3 (expt 2 30))
  (size->number "3GiB"))

(test-equal "size->number, 1.2GiB"
  (inexact->exact (round (* 1.2 (expt 2 30))))
  (size->number "1.2GiB"))

(test-equal "size->number, 1T"
  (expt 2 40)
  (size->number "1T"))

(test-equal "size->number, 1.M"
  (expt 2 20)
  (size->number "1.M"))

(test-assert "size->number, invalid unit"
  (catch 'quit
    (lambda ()
      (size->number "9X"))
    (lambda args
      #t)))

(test-equal "show-what-to-build, zero outputs"
  ""
  (with-store store
    (let ((drv (derivation store "zero" "/bin/sh" '()
                           #:outputs '())))
      (with-error-to-string
       (lambda ()
         ;; This should print nothing.
         (show-what-to-build store (list drv)))))))

(test-assert "show-manifest-transaction"
  (let* ((m (manifest (list guile-1.8.8)))
         (t (manifest-transaction (install (list guile-2.0.9)))))
    (with-store store
      (and (string-match "guile\t1.8.8 → 2.0.9"
                         (with-fluids ((%default-port-encoding "UTF-8"))
                           (with-error-to-string
                            (lambda ()
                              (show-manifest-transaction store m t)))))
           (string-match "guile\t1.8.8 -> 2.0.9"
                         (with-error-to-string
                           (lambda ()
                             ;; In Guile 2.2, %DEFAULT-PORT-ENCODING doesn't
                             ;; influence the encoding of string ports.
                             (set-port-encoding! (current-error-port)
                                                 "ISO-8859-1")
                             (show-manifest-transaction store m t))))))))

(test-assert "package-relevance"
  (let ((guile  (specification->package "guile"))
        (gcrypt (specification->package "guile-gcrypt"))
        (go     (specification->package "go"))
        (gnugo  (specification->package "gnugo"))
        (libb2  (specification->package "libb2"))
        (rx     (cut make-regexp <> regexp/icase))
        (>0     (cut > <> 0))
        (=0     zero?))
    (and (>0 (package-relevance guile
                                (map rx '("scheme"))))
         (>0 (package-relevance guile
                                (map rx '("scheme" "implementation"))))
         (>0 (package-relevance gcrypt
                                (map rx '("guile" "crypto"))))
         (=0 (package-relevance guile
                                (map rx '("guile" "crypto"))))
         (>0 (package-relevance go
                                (map rx '("go"))))
         (=0 (package-relevance go
                                (map rx '("go" "game"))))
         (>0 (package-relevance gnugo
                                (map rx '("go" "game"))))
         (>0 (package-relevance libb2
                                (map rx '("crypto" "library")))))))

(test-end "ui")