;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; 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/l</td></tr></table>
<table class='tabs'><tr><td>
<a href='/guix/about/'>about</a><a href='/guix/'>summary</a><a href='/guix/refs/?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>refs</a><a href='/guix/log/gnu/installer/connman.scm'>log</a><a href='/guix/tree/gnu/installer/connman.scm?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>tree</a><a class='active' href='/guix/commit/gnu/installer/connman.scm?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>commit</a><a href='/guix/diff/gnu/installer/connman.scm?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>diff</a></td><td class='form'><form class='right' method='get' action='/guix/log/gnu/installer/connman.scm'>
<input type='hidden' name='id' value='c8c444dbd27303b330ff3d8217b5ce162232e815'/><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/commit/?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>root</a>/<a href='/guix/commit/gnu?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>gnu</a>/<a href='/guix/commit/gnu/installer?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>installer</a>/<a href='/guix/commit/gnu/installer/connman.scm?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>connman.scm</a></div><div class='content'><div class='cgit-panel'><b>diff options</b><form method='get'><input type='hidden' name='id' value='c8c444dbd27303b330ff3d8217b5ce162232e815'/><table><tr><td colspan='2'/></tr><tr><td class='label'>context:</td><td class='ctrl'><select name='context' onchange='this.form.submit();'><option value='1'>1</option><option value='2'>2</option><option value='3' selected='selected'>3</option><option value='4'>4</option><option value='5'>5</option><option value='6'>6</option><option value='7'>7</option><option value='8'>8</option><option value='9'>9</option><option value='10'>10</option><option value='15'>15</option><option value='20'>20</option><option value='25'>25</option><option value='30'>30</option><option value='35'>35</option><option value='40'>40</option></select></td></tr><tr><td class='label'>space:</td><td class='ctrl'><select name='ignorews' onchange='this.form.submit();'><option value='0' selected='selected'>include</option><option value='1'>ignore</option></select></td></tr><tr><td class='label'>mode:</td><td class='ctrl'><select name='dt' onchange='this.form.submit();'><option value='0' selected='selected'>unified</option><option value='1'>ssdiff</option><option value='2'>stat only</option></select></td></tr><tr><td/><td class='ctrl'><noscript><input type='submit' value='reload'/></noscript></td></tr></table></form></div><table summary='commit info' class='commit-info'>
<tr><th>author</th><td>Efraim Flashner &lt;efraim@flashner.co.il&gt;</td><td class='right'>2022-07-11 09:44:40 +0300</td></tr>
<tr><th>committer</th><td>Efraim Flashner &lt;efraim@flashner.co.il&gt;</td><td class='right'>2022-07-11 09:44:40 +0300</td></tr>
<tr><th>commit</th><td colspan='2' class='oid'><a href='/guix/commit/gnu/installer/connman.scm?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>c8c444dbd27303b330ff3d8217b5ce162232e815</a> (<a href='/guix/patch/gnu/installer/connman.scm?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>patch</a>)</td></tr>
<tr><th>tree</th><td colspan='2' class='oid'><a href='/guix/tree/?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>6c40e6e17dbfe1eea36fa9111fdc0b123ccf34c1</a> /<a href='/guix/tree/gnu/installer/connman.scm?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>gnu/installer/connman.scm</a></td></tr>
<tr><th>parent</th><td colspan='2' class='oid'><a href='/guix/commit/gnu/installer/connman.scm?id=c9fad6a2ad8c530ba5a5a78f6e9349a038e8ae88'>c9fad6a2ad8c530ba5a5a78f6e9349a038e8ae88</a> (<a href='/guix/diff/gnu/installer/connman.scm?id=c8c444dbd27303b330ff3d8217b5ce162232e815&amp;id2=c9fad6a2ad8c530ba5a5a78f6e9349a038e8ae88'>diff</a>)</td></tr><tr><th>download</th><td colspan='2' class='oid'><a href='/guix/snapshot/guix-c8c444dbd27303b330ff3d8217b5ce162232e815.tar.gz'>guix-c8c444dbd27303b330ff3d8217b5ce162232e815.tar.gz</a><br/><a href='/guix/snapshot/guix-c8c444dbd27303b330ff3d8217b5ce162232e815.zip'>guix-c8c444dbd27303b330ff3d8217b5ce162232e815.zip</a><br/></td></tr></table>
<div class='commit-subject'>gnu: parallel: Update to 20220622.</div><div class='commit-msg'>* gnu/packages/parallel.scm (parallel): Update to 20220622.
[arguments]: Add phase to add parallel to the PATH.
</div><div class='diffstat-header'><a href='/guix/diff/?id=c8c444dbd27303b330ff3d8217b5ce162232e815'>Diffstat</a> (limited to 'gnu/installer/connman.scm')</div><table summary='diffstat' class='diffstat'></table><div class='diffstat-summary'>0 files changed, 0 insertions, 0 deletions</div><table summary='diff' class='diff'><tr><td></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>
red-port `(,%gzip "-c" "--fast")
                                  (open-bytevector-input-port data)))
                  ((decompressed pids2)
                   (filtered-port `(,%gzip "-d") compressed)))
      (and (pk (every (compose zero? cdr waitpid)
                   (append pids1 pids2)))
           (equal? (get-bytevector-all decompressed) data)))))

(test-assert "filtered-port, does not exist"
  (let* ((file  (search-path %load-path "guix.scm"))
         (input (open-file file "r0b")))
    (let-values (((port pids)
                  (filtered-port '("/does/not/exist") input)))
      (any (compose (negate zero?) cdr waitpid)
           pids))))

(define (test-compression/decompression method run?)
  "Test METHOD, a symbol such as 'gzip.  Call RUN? to determine whether to
skip these tests."
  (unless (run?) (test-skip 1))
  (test-assert (format #f "compressed-port, decompressed-port, non-file [~a]"
                       method)
    (let ((data (call-with-input-file (search-path %load-path "guix.scm")
                  get-bytevector-all)))
      (call-with-temporary-output-file
       (lambda (output port)
         (close-port port)
         (let*-values (((compressed pids)
                        ;; Note: 'compressed-output-port' only supports file
                        ;; ports.
                        (compressed-output-port method
                                                (open-file output "w0"))))
           (put-bytevector compressed data)
           (close-port compressed)
           (and (every (compose zero? cdr waitpid)
                       (pk 'pids method pids))
                (let*-values (((decompressed pids)
                               (decompressed-port method
                                                  (open-bytevector-input-port
                                                   (call-with-input-file output
                                                     get-bytevector-all))))
                              ((result)
                               (get-bytevector-all decompressed)))
                  (close-port decompressed)
                  (pk 'len method
                      (if (bytevector? result)
                          (bytevector-length result)
                          result)
                      (bytevector-length data))
                  (and (every (compose zero? cdr waitpid)
                              (pk 'pids method pids))
                       (equal? result data)))))))))

  (false-if-exception (delete-file temp-file))
  (unless (run?) (test-skip 1))
  (test-assert (format #f "compressed-output-port + decompressed-port [~a]"
                       method)
    (let* ((file (search-path %load-path "guix/derivations.scm"))
           (data (call-with-input-file file get-bytevector-all))
           (port (open-file temp-file "w0b")))
      (call-with-compressed-output-port method port
        (lambda (compressed)
          (put-bytevector compressed data)))
      (close-port port)

      (bytevector=? data
                    (call-with-decompressed-port method (open-file temp-file "r0b")
                      get-bytevector-all)))))

(for-each test-compression/decompression
          `(gzip xz lzip zstd)
          (list (const #t) (const #t) (const #t)
                (lambda ()
                  (resolve-module '(zstd) #t #f #:ensure #f))))

;; This is actually in (guix store).
(test-equal "store-path-package-name"
  "bash-4.2-p24"
  (store-path-package-name
   (string-append (%store-prefix)
                  "/qvs2rj2ia5vci3wsdb7qvydrmacig4pg-bash-4.2-p24")))

(test-equal "canonical-newline-port"
  "This is a journey\nInto the sound\nA journey ...\n"
  (let ((port (open-string-input-port
               "This is a journey\r\nInto the sound\r\nA journey ...\n")))
    (get-string-all (canonical-newline-port port))))

(test-equal "canonical-newline-port-1024"
  (string-concatenate (make-list 100 "0123456789abcde\n"))
  (let ((port (open-string-input-port
               (string-concatenate
                (make-list 100 "0123456789abcde\r\n")))))
    (get-string-all (canonical-newline-port port))))

(test-equal "edit-expression"
  "(display \"GNU Guix\")\n(newline)\n"
  (begin
    (call-with-output-file temp-file
      (lambda (port)
        (display "(display \"xiuG UNG\")\n(newline)\n" port)))
    (edit-expression `((filename . ,temp-file)
                       (line     . 0)
                       (column   . 9))
                     string-reverse)
    (call-with-input-file temp-file get-string-all)))

(test-equal "string-distance"
  '(0 1 1 5 5)
  (list
   (string-distance "hello" "hello")
   (string-distance "hello" "helo")
   (string-distance "helo" "hello")
   (string-distance "" "hello")
   (string-distance "hello" "")))

(test-equal "string-closest"
  '("hello" "hello" "helo" #f)
  (list
   (string-closest "hello" '("hello"))
   (string-closest "hello" '("helo" "hello" "halo"))
   (string-closest "hello" '("kikoo" "helo" "hihihi" "halo"))
   (string-closest "hello" '("aaaaa" "12345" "hellohello" "h"))))

(test-equal "target-linux?"
  '(#t #f #f #t)
  (map target-linux?
       '("i686-linux-gnu" "i686-w64-mingw32"
         ;; Checking that "gnu" is present is not sufficient,
         ;; as GNU/Hurd exists.
         "i686-pc-gnu"
         ;; Some targets have a suffix.
         "arm-linux-gnueabihf")))

(test-equal "target-mingw?"
  '(#f #f #t)
  (map target-mingw?
       '("i686-linux-gnu" "i686-pc-gnu"
         "i686-w64-mingw32")))

(test-equal "target-x86-32?"
  '(#f #f #f #t #t #t #t #f)
  ;; These are (according to Wikipedia) two RISC architectures
  ;; by Intel and presumably not compatible with the x86-32 series.
  (map target-x86-32?
       '("i860-gnu" "i960-gnu"
         ;; This is a 16-bit architecture
         "i286-gnu"
         ;; These are part of the x86-32 series.
         "i386-gnu" "i486-gnu" "i586-gnu" "i686-gnu"
         ;; Maybe this one will exist some day, but not yet.
         "i786-gnu")))

(test-equal "target-x86-64?"
  '(#t #f #f #f)
  (map target-x86-64?
       `("x86_64-linux-gnu" "i386-linux-gnu"
         ;; Just because it includes "64" doesn't make it 64-bit.
         "aarch64-linux-gnu"
         ;; Note that (expt 2 109) in decimal notation starts with 64.
         ;; However, it isn't 32-bit.
         ,(format #f "x86_~a-linux-gnu" (expt 2 109)))))

(test-end)

(false-if-exception (delete-file temp-file))