2017-08-17 20:56:15 +05:30
|
|
|
(library
|
|
|
|
(cache-functional-tests)
|
|
|
|
(export register-cache-tests)
|
|
|
|
(import (chezscheme)
|
2017-08-25 15:56:09 +05:30
|
|
|
(disk-units)
|
2017-08-17 20:56:15 +05:30
|
|
|
(functional-tests)
|
|
|
|
(cache-xml)
|
|
|
|
(fmt fmt)
|
2017-08-25 14:16:56 +05:30
|
|
|
(process)
|
2017-08-25 15:56:09 +05:30
|
|
|
(scenario-string-constants)
|
2017-08-23 15:18:33 +05:30
|
|
|
(temp-file)
|
2017-08-17 20:56:15 +05:30
|
|
|
(srfi s8 receive))
|
|
|
|
|
|
|
|
(define-tool cache-check)
|
|
|
|
(define-tool cache-dump)
|
|
|
|
(define-tool cache-restore)
|
|
|
|
(define-tool cache-metadata-size)
|
2019-10-08 19:04:24 +05:30
|
|
|
(define-tool cache-repair)
|
2017-08-17 20:56:15 +05:30
|
|
|
|
2017-08-24 18:33:07 +05:30
|
|
|
(define-syntax with-cache-xml
|
|
|
|
(syntax-rules ()
|
|
|
|
((_ (v) b1 b2 ...)
|
2017-08-29 19:16:59 +05:30
|
|
|
(with-temp-file-containing ((v "cache.xml" (fmt #f (generate-xml 512 1024 128))))
|
2017-08-24 18:33:07 +05:30
|
|
|
b1 b2 ...))))
|
2017-08-17 20:56:15 +05:30
|
|
|
|
|
|
|
(define-syntax with-valid-metadata
|
|
|
|
(syntax-rules ()
|
2017-08-25 15:56:09 +05:30
|
|
|
((_ (md) b1 b2 ...)
|
2017-12-12 20:57:20 +05:30
|
|
|
(with-temp-file-sized ((md "cache.bin" (to-bytes (meg 4))))
|
2017-08-25 15:56:09 +05:30
|
|
|
(with-cache-xml (xml)
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-ok (cache-restore "-i" xml "-o" md))
|
2017-08-25 15:56:09 +05:30
|
|
|
b1 b2 ...)))))
|
2017-08-17 20:56:15 +05:30
|
|
|
|
|
|
|
;;; It would be nice if the metadata was at least similar to valid data.
|
|
|
|
(define-syntax with-corrupt-metadata
|
|
|
|
(syntax-rules ()
|
2017-08-25 15:56:09 +05:30
|
|
|
((_ (md) b1 b2 ...)
|
2017-12-12 20:57:20 +05:30
|
|
|
(with-temp-file-sized ((md "cache.bin" (to-bytes (meg 4))))
|
2019-10-08 19:04:24 +05:30
|
|
|
(system (fmt #f "dd if=/usr/bin/ls of=" md " bs=4096 > /dev/null 2>&1"))
|
|
|
|
b1 b2 ...))))
|
2017-08-17 20:56:15 +05:30
|
|
|
|
2017-08-25 19:33:50 +05:30
|
|
|
(define-syntax with-empty-metadata
|
|
|
|
(syntax-rules ()
|
|
|
|
((_ (md) b1 b2 ...)
|
2017-12-12 20:57:20 +05:30
|
|
|
(with-temp-file-sized ((md "cache.bin" (to-bytes (meg 4))))
|
2017-08-25 19:33:50 +05:30
|
|
|
b1 b2 ...))))
|
|
|
|
|
2017-08-17 20:56:15 +05:30
|
|
|
;; We have to export something that forces all the initialisation expressions
|
|
|
|
;; to run.
|
|
|
|
(define (register-cache-tests) #t)
|
|
|
|
|
2017-08-25 19:33:50 +05:30
|
|
|
;;;-----------------------------------------------------------
|
|
|
|
;;; cache_dump scenarios
|
|
|
|
;;;-----------------------------------------------------------
|
|
|
|
|
2017-09-21 14:52:38 +05:30
|
|
|
(define-scenario (cache-dump small-input-file)
|
|
|
|
"Fails with small input file"
|
|
|
|
(with-temp-file-sized ((md "cache.bin" 512))
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-fail
|
|
|
|
(cache-dump md))))
|
2017-09-21 14:52:38 +05:30
|
|
|
|
2017-08-30 14:41:45 +05:30
|
|
|
;;;-----------------------------------------------------------
|
|
|
|
;;; cache_metadata_size scenarios
|
|
|
|
;;;-----------------------------------------------------------
|
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size v)
|
2017-08-31 14:39:58 +05:30
|
|
|
"cache_metadata_size -V"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-ok-rcv (stdout _) (cache-metadata-size "-V")
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal tools-version stdout)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size version)
|
2017-08-31 14:39:58 +05:30
|
|
|
"cache_metadata_size --version"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-ok-rcv (stdout _) (cache-metadata-size "--version")
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal tools-version stdout)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size h)
|
2017-08-31 14:39:58 +05:30
|
|
|
"cache_metadata_size -h"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-ok-rcv (stdout _) (cache-metadata-size "-h")
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal cache-metadata-size-help stdout)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size help)
|
2017-08-31 14:39:58 +05:30
|
|
|
"cache_metadata_size --help"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-ok-rcv (stdout _) (cache-metadata-size "--help")
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal cache-metadata-size-help stdout)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size no-args)
|
2017-08-31 14:39:58 +05:30
|
|
|
"No arguments specified causes fail"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-fail-rcv (_ stderr) (cache-metadata-size)
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal "Please specify either --device-size and --block-size, or --nr-blocks."
|
|
|
|
stderr)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size device-size-only)
|
2017-08-31 14:39:58 +05:30
|
|
|
"Just --device-size causes fail"
|
2017-12-12 20:57:20 +05:30
|
|
|
(run-fail-rcv (_ stderr) (cache-metadata-size "--device-size" (to-bytes (meg 100)))
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal "If you specify --device-size you must also give --block-size."
|
|
|
|
stderr)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size block-size-only)
|
2017-08-31 14:39:58 +05:30
|
|
|
"Just --block-size causes fail"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-fail-rcv (_ stderr) (cache-metadata-size "--block-size" 128)
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal "If you specify --block-size you must also give --device-size."
|
|
|
|
stderr)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size conradictory-info-fails)
|
2017-08-31 14:39:58 +05:30
|
|
|
"Contradictory info causes fail"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-fail-rcv (_ stderr) (cache-metadata-size "--device-size 102400 --block-size 1000 --nr-blocks 6")
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal "Contradictory arguments given, --nr-blocks doesn't match the --device-size and --block-size."
|
|
|
|
stderr)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size all-args-agree)
|
2017-08-31 14:39:58 +05:30
|
|
|
"All args agreeing succeeds"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-ok-rcv (stdout stderr) (cache-metadata-size "--device-size" 102400 "--block-size" 100 "--nr-blocks" 1024)
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal "8248 sectors" stdout)
|
|
|
|
(assert-eof stderr)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size nr-blocks-alone)
|
2017-08-31 14:39:58 +05:30
|
|
|
"Just --nr-blocks succeeds"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-ok-rcv (stdout stderr) (cache-metadata-size "--nr-blocks" 1024)
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal "8248 sectors" stdout)
|
|
|
|
(assert-eof stderr)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size dev-size-and-block-size-succeeds)
|
2017-08-31 14:39:58 +05:30
|
|
|
"Specifying --device-size with --block-size succeeds"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-ok-rcv (stdout stderr) (cache-metadata-size "--device-size" 102400 "--block-size" 100)
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal "8248 sectors" stdout)
|
|
|
|
(assert-eof stderr)))
|
2017-08-30 14:41:45 +05:30
|
|
|
|
|
|
|
(define-scenario (cache-metadata-size big-config)
|
2017-08-31 14:39:58 +05:30
|
|
|
"A big configuration succeeds"
|
2017-10-10 21:21:31 +05:30
|
|
|
(run-ok-rcv (stdout stderr) (cache-metadata-size "--nr-blocks 67108864")
|
2017-08-31 14:39:58 +05:30
|
|
|
(assert-equal "3678208 sectors" stdout)
|
|
|
|
(assert-eof stderr)))
|
2017-09-15 16:56:54 +05:30
|
|
|
)
|