;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.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-glob)
  #:use-module (guix glob)
  #:use-module (srfi srfi-64))


(test-begin "glob")

(define-syntax test-string->sglob
  (syntax-rules (=>)
    ((_ pattern => result rest ...)
     (begin
       (test-equal (format #f "string->sglob, ~s" pattern)
         result
         (string->sglob pattern))
       (test-string->sglob rest ...)))
    ((_)
     #t)))

(define-syntax test-glob-match
  (syntax-rules (matches and not)
    ((_ (pattern-string matches strings ... (and not others ...)) rest ...)
     (begin
       (test-assert (format #f "glob-match? ~s" pattern-string)
         (let ((pattern (string->compiled-sglob pattern-string)))
           (and (glob-match? pattern strings) ...
                (not (glob-match? pattern others)) ...)))
       (test-glob-match rest ...)))
    ((_)
     #t)))

(test-string->sglob
 "foo" => "foo"
 "?foo*" => '(? "foo" *)
 "foo[1-5]" => '("foo" (range #\1 #\5))
 "foo[abc]bar" => '("foo" (set #\a #\b #\c) "bar")
 "foo[a[b]c]bar" => '("foo" (set #\a #\[ #\b #\] #\c) "bar")
 "[123]x" => '((set #\1 #\2 #\3) "x")
 "[a-z]" => '((range #\a<pre>
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2022, 2024 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;.

(define-module (test-cpio)
  #:use-module (guix cpio)
  #:use-module (guix tests)
  #:use-module ((guix build utils)
                #:select (which call-with-temporary-output-file))
  #:use-module (ice-9 match)
  #:use-module (ice-9 popen)
  #:use-module (rnrs io ports)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64))

(define %cpio-program
  (which &quot;cpio&quot;))

(define %test-file
  (search-path %load-path &quot;guix.scm&quot;))


(test-begin &quot;cpio&quot;)

;; The cpio format expects &apos;ino&apos; to fit in 32 bits.  If we have a bigger inode
;; number, skip this test.
(test-skip
 (if (&gt;= (stat:ino (lstat %test-file)) (expt 2 32)) 1 0))
(test-assert &quot;file-&gt;cpio-header + write-cpio-header + read-cpio-header&quot;
  (let* ((header (file-&gt;cpio-header %test-file)))
    (call-with-values
        (lambda ()
          (open-bytevector-output-port))
      (lambda (port get-bv)
        (write-cpio-header header port)
        (let ((port (open-bytevector-input-port (get-bv))))
          (equal? header (read-cpio-header port)))))))

(unless %cpio-program (test-skip 1))
(test-assert &quot;bit-identical to GNU cpio&apos;s output&quot;
  (call-with-temporary-output-file
   (lambda (link _)
     (delete-file link)
     (symlink &quot;chbouib&quot; link)

     (let ((files (cons* &quot;/&quot;
                         (canonicalize-path
                          (dirname (search-path %load-path &quot;guix.scm&quot;)))
                         link
                         (map (compose canonicalize-path
                                       (cut search-path %load-path &lt;&gt;))
                              &apos;(&quot;guix.scm&quot; &quot;guix/build/syscalls.scm&quot;
                                &quot;guix/packages.scm&quot;)))))
       (call-with-temporary-output-file
        (lambda (ref-file _)
          (let ((pipe (open-pipe* OPEN_WRITE %cpio-program &quot;-o&quot; &quot;-O&quot; ref-file
                                  &quot;-H&quot; &quot;newc&quot; &quot;--null&quot;)))
            (for-each (lambda (file)
                        (format pipe &quot;~a\0&quot; file))
                      files)
            (and (zero? (close-pipe pipe))
                 (call-with-temporary-output-file
                  (lambda (file port)
                    (write-cpio-archive files port)
                    (close-port port)
                    (or (file=? ref-file file)
                        (throw &apos;cpio-archives-differ files
                               ref-file file
                               (stat:size (stat ref-file))
                               (stat:size (stat file))))))))))))))

(test-end &quot;cpio&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>