Disarchive/tests/cli.scm

;;; Disarchive
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Disarchive.
;;;
;;; Disarchive 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.
;;;
;;; Disarchive 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 Disarchive.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (disarchive)
             (disarchive assemblers)
             (disarchive config)
             (disarchive digests)
             (disarchive utils)
             (ice-9 binary-ports)
             (ice-9 popen)
             (ice-9 textual-ports)
             (rnrs bytevectors)
             (srfi srfi-64))

(define status-ok? (compose zero? status:exit-val))
(define status-error? (compose not status-ok?))

(define data
  (or (getenv "DISARCHIVE_TEST_DATA")
      (error "The DISARCHIVE_TEST_DATA variable is not set")))

(define (capture/error cli)
  (let* ((cli* (string-append "2>&1 1>/dev/null " cli))
         (port (open-pipe cli* OPEN_READ))
         (output (get-string-all port)))
    (unless (status-error? (close-pipe port))
      (error "Program exited normally" cli*))
    output))

(define (capture/ok cli)
  (let* ((port (open-pipe cli OPEN_READ))
         (output (get-string-all port)))
    (unless (status-ok? (close-pipe port))
      (error "Program exited abnormally" cli))
    output))

(define (file=? file1 file2)
  (let ((bv1 (call-with-input-file file1 get-bytevector-all))
        (bv2 (call-with-input-file file2 get-bytevector-all)))
    (bytevector=? bv1 bv2)))

(define (specification=? spec1 spec2)
  (let* ((bp1 (specification->blueprint spec1))
         (digest1 (blueprint-digest bp1))
         (bp2 (specification->blueprint spec2))
         (digest2 (blueprint-digest bp2)))
    (equal? digest1 digest2)))

(test-begin "cli")


;; The root command

(test-assert "Errors on bogus option"
  (status-error? (system "disarchive --foo")))

(test-assert "Prints usage on option error"
  (let ((output (capture/error "disarchive --foo")))
    (or (string-contains output "Usage")
        (string-contains output "usage"))))

(test-assert "Errors on bogus command"
  (status-error? (system "disarchive foo")))

(test-assert "Prints usage on bogus command"
  (let ((output (capture/error "disarchive foo")))
    (or (string-contains output "Usage")
        (string-contains output "usage"))))

(test-assert "Errors when given no options"
  (status-error? (system "disarchive")))

(test-assert "Accepts --version"
  (status-ok? (system "disarchive --version")))

(test-assert "Version includes package name and version"
  (let ((version (capture/ok "disarchive --version")))
    (and (string-contains version %package-name)
         (string-contains version %version))))

(test-assert "Accepts --help"
  (status-ok? (system "disarchive --help")))


;; The assemble subcommand

(test-assert "Accepts --help (assemble)"
  (status-ok? (system "disarchive assemble --help")))

(test-assert "Accepts --version (assemble)"
  (status-ok? (system "disarchive assemble --version")))

(test-assert "Errors on bogus option (assemble)"
  (status-error? (system "disarchive assemble --foo")))

(test-assert "Prints usage on option error (assemble)"
  (let ((output (capture/error "disarchive assemble --foo")))
    (and (string-contains output "assemble")
         (or (string-contains output "Usage")
             (string-contains output "usage")))))

(test-assert "Errors on missing options (assemble)"
  (status-error? (system "disarchive assemble")))

(test-assert "Prints usage on missing options (assemble)"
  (let ((output (capture/error "disarchive assemble")))
    (and (string-contains output "assemble")
         (or (string-contains output "Usage")
             (string-contains output "usage")))))


(test-assert "Assembles from stdin to stdout"
  (let ((spec (string-append data "/test-archive.da"))
        (directory (string-append data "/test-archive"))
        (expected (string-append data "/test-archive.tar")))
    (call-with-temporary-output-file
     (lambda (filename port)
       (let ((status (with-input-from-file spec
                       (lambda ()
                         (with-output-to-port port
                           (lambda ()
                             (system* "disarchive" "assemble"
                                      directory "-")))))))
         (close-port port)
         (and (status-ok? status)
              (file=? filename expected)))))))

(test-assert "Assembles from stdin to file"
  (let ((spec (string-append data "/test-archive.da"))
        (directory (string-append data "/test-archive"))
        (expected (string-append data "/test-archive.tar")))
    (call-with-temporary-output-file
     (lambda (filename port)
       (close-port port)
       (let ((status (with-input-from-file spec
                       (lambda ()
                         (system* "disarchive" "assemble"
                                  "-o" filename directory "-")))))
         (and (status-ok? status)
              (file=? filename expected)))))))

(test-assert "Assembles from file to stdout"
  (let ((spec (string-append data "/test-archive.da"))
        (directory (string-append data "/test-archive"))
        (expected (string-append data "/test-archive.tar")))
    (call-with-temporary-output-file
     (lambda (filename port)
       (let ((status (with-output-to-port port
                       (lambda ()
                         (system* "disarchive" "assemble"
                                  directory spec)))))
         (close-port port)
         (and (status-ok? status)
              (file=? filename expected)))))))

(test-assert "Assembles from file to file"
  (let ((spec (string-append data "/test-archive.da"))
        (directory (string-append data "/test-archive"))
        (expected (string-append data "/test-archive.tar")))
    (call-with-temporary-output-file
     (lambda (filename port)
       (close-port port)
       (and (status-ok? (system* "disarchive" "assemble"
                                 "-o" filename directory spec))
            (file=? filename expected))))))


;; The disassemble subcommand

(test-assert "Accepts --help (disassemble)"
  (status-ok? (system "disarchive disassemble --help")))

(test-assert "Accepts --version (disassemble)"
  (status-ok? (system "disarchive disassemble --version")))

(test-assert "Errors on bogus option (disassemble)"
  (status-error? (system "disarchive disassemble --foo")))

(test-assert "Prints usage on option error (disassemble)"
  (let ((output (capture/error "disarchive disassemble --foo")))
    (and (string-contains output "disassemble")
         (or (string-contains output "Usage")
             (string-contains output "usage")))))

(test-assert "Errors on missing options (disassemble)"
  (status-error? (system "disarchive disassemble")))

(test-assert "Prints usage on missing options (disassemble)"
  (let ((output (capture/error "disarchive disassemble")))
    (and (string-contains output "disassemble")
         (or (string-contains output "Usage")
             (string-contains output "usage")))))

(test-assert "Disassembles from file to stdout"
  (let ((archive (string-append data "/test-archive.tar"))
        (expected (string-append data "/test-archive.da")))
    (call-with-temporary-output-file
     (lambda (filename port)
       (let ((status (with-output-to-port port
                       (lambda ()
                         (system* "disarchive" "disassemble" archive)))))
         (close-port port)
         (and (status-ok? status)
              (specification=? filename expected)))))))

(test-assert "Disassembles from file to file"
  (let ((archive (string-append data "/test-archive.tar"))
        (expected (string-append data "/test-archive.da")))
    (call-with-temporary-output-file
     (lambda (filename port)
       (close-port port)
       (and (status-ok? (system* "disarchive" "disassemble"
                                 "-o" filename archive))
            (specification=? filename expected))))))

(test-equal "Disassembles with basename by default"
  "test-archive.tar"
  (let ((archive (string-append data "/test-archive.tar")))
    (call-with-temporary-output-file
     (lambda (filename port)
       (close-port port)
       (and (status-ok? (system* "disarchive" "disassemble"
                                 "-o" filename archive))
            (let ((bp (specification->blueprint filename)))
              (blueprint-name bp)))))))

(test-equal "Disassembles with a given name"
  "foobar.tar"
  (let ((archive (string-append data "/test-archive.tar")))
    (call-with-temporary-output-file
     (lambda (filename port)
       (close-port port)
       (and (status-ok? (system* "disarchive" "disassemble"
                                 "-n" "foobar.tar" "-o" filename archive))
            (let ((bp (specification->blueprint filename)))
              (blueprint-name bp)))))))

(test-end "cli")