(library
  (cache-functional-tests)
  (export register-cache-tests)
  (import (chezscheme)
          (functional-tests)
          (cache-xml)
          (fmt fmt)
          (srfi s8 receive))

  (define-tool cache-check)
  (define-tool cache-dump)
  (define-tool cache-restore)
  (define-tool cache-metadata-size)

  (define (current-metadata) "metadata.bin")

  (define (temp-cache-xml)
    (temp-file-containing (fmt #f (generate-xml 512 1024 128))))

  (define (%with-valid-metadata thunk)
    (cache-restore "-i" (temp-cache-xml) "-o" (current-metadata))
    (thunk))

  (define-syntax with-valid-metadata
    (syntax-rules ()
      ((_ body ...)
       (%with-valid-metadata (lambda () body ...)))))

  ;;; It would be nice if the metadata was at least similar to valid data.
  (define (%with-corrupt-metadata thunk)
    (run-ok "dd if=/dev/zero" (fmt #f "of=" (current-metadata)) "bs=64M count=1")
    (thunk))

  (define-syntax with-corrupt-metadata
    (syntax-rules ()
      ((_ body ...) (%with-corrupt-metadata (lambda () body ...)))))


  ;; We have to export something that forces all the initialisation expressions
  ;; to run.
  (define (register-cache-tests) #t)

  (define cache-check-help
    "Usage: cache_check [options] {device|file}
Options:
  {-q|--quiet}
  {-h|--help}
  {-V|--version}
  {--clear-needs-check-flag}
  {--super-block-only}
  {--skip-mappings}
  {--skip-hints}
  {--skip-discards}")

  ;;;-----------------------------------------------------------
  ;;; cache_check scenarios
  ;;;-----------------------------------------------------------

  (define-scenario (cache-check v)
                   "cache_check -V"
                   (receive (stdout _) (cache-check "-V")
                            (assert-equal tools-version stdout)))

  (define-scenario (cache-check version)
                   "cache_check --version"
                   (receive (stdout _) (cache-check "--version")
                            (assert-equal tools-version stdout)))

  (define-scenario (cache-check h)
                   "cache_check -h"
                   (receive (stdout _) (cache-check "-h")
                            (assert-equal cache-check-help stdout)))

  (define-scenario (cache-check help)
                   "cache_check --help"
                   (receive (stdout _) (cache-check "--help")
                            (assert-equal cache-check-help stdout)))

  (define-scenario (cache-check must-specify-metadata)
                   "Metadata file must be specified"
                   (receive (_ stderr) (run-fail "cache_check")
                            (assert-equal
                              (string-append "No input file provided.\n"
                                             cache-check-help)
                              stderr)))

  (define-scenario (cache-check no-such-metadata)
                   "Metadata file doesn't exist."
                   (let ((bad-path "/arbitrary/filename"))
                    (receive (_ stderr) (run-fail "cache_check" bad-path)
                             (assert-starts-with
                               (string-append bad-path ": No such file or directory")
                               stderr))))

  (define-scenario (cache-check metadata-file-cannot-be-a-directory)
                   "Metadata file must not be a directory"
                   (let ((bad-path "/tmp"))
                    (receive (_ stderr) (run-fail "cache_check" bad-path)
                             (assert-starts-with
                               (string-append bad-path ": Not a block device or regular file")
                               stderr))))

  #|
  (define-scenario (cache-check unreadable-metadata)
                   "Metadata file exists, but is unreadable."
                   (with-valid-metadata
                     (run-ok "chmod" "-r" (current-metadata))
                     (receive (_ stderr) (run-fail "cache_check" (current-metadata))
                              (assert-starts-with "syscall 'open' failed: Permission denied" stderr))))
  |#
  (define-scenario (cache-check fails-with-corrupt-metadata)
                   "Fail with corrupt superblock"
                   (with-corrupt-metadata
                     (run-fail "cache_check" (current-metadata))))

  (define-scenario (cache-check failing-q)
                   "Fail quietly with -q"
                   (with-corrupt-metadata
                     (receive (stdout stderr) (run-fail "cache_check" "-q" (current-metadata))
                              (assert-eof stdout)
                              (assert-eof stderr))))
)