Merge branch 'master' of github.com:jthornber/thin-provisioning-tools

This commit is contained in:
Joe Thornber
2017-10-10 10:29:53 +01:00
10 changed files with 137 additions and 19 deletions

View File

@@ -134,9 +134,9 @@
(run-fail "cache_check" md))))
(define-scenario (cache-check tiny-metadata)
"Prints helpful message in case XML metadata given"
(with-cache-xml (xml)
(receive (_ stderr) (run-fail "cache_check" xml)
"Prints helpful message in case tiny metadata given"
(with-temp-file-sized ((md "cache.bin" 1024))
(receive (_ stderr) (run-fail "cache_check" md)
(assert-starts-with "Metadata device/file too small. Is this binary metadata?" stderr))))
(define-scenario (cache-check spot-accidental-xml-data)

View File

@@ -194,11 +194,15 @@
(map foreign-free acc)
(loop (ftype-ref Target (next) t) (cons t acc)))))
;; targets should be dlambdas with 'size, 'type and 'format methods
(define (load-table dm name targets)
(define load
(foreign-procedure "dm_load" ((* DMIoctlInterface) string (* Target)) int))
(let* ((ctargets (build-c-targets targets))
(define (dlambda->target t)
(make-target (t 'size) (t 'type) (t 'format)))
(let* ((ctargets (build-c-targets (map dlambda->target targets)))
(r (load dm name ctargets)))
(free-c-targets ctargets)
(unless (zero? r)

View File

@@ -0,0 +1,36 @@
(library
(device-mapper targets)
(export linear-target)
(import (chezscheme)
(fmt fmt)
(list-utils))
(define-record-type segment
(fields (mutable dev) (mutable begin) (mutable end)))
(define (segment-size s)
(- (segment-end s)
(segment-begin s)))
(define (join docs)
(cat (intersperse (dsp " ") docs)))
(define (format-segment s)
(join (dsp (segment-dev s))))
(define (linear-target seg)
(dlambda
(type () 'linear)
(size () (segment-size seg))
(format () (fmt #f (format-segment s)))))
(define (stripe-target segments)
(unless (apply = (map segment-size segments))
(fail "stripe segments must all be the same size")
(dlambda
(type () 'stripe)
(size () (fold-right + 0 (map segment-size segments)))
(format () (fmt #f (join (map format-segment segments)))))))
)

View File

@@ -108,9 +108,9 @@
(assert-eof stderr))))
(define-scenario (era-check tiny-metadata)
"Prints helpful message in case XML metadata given"
(with-era-xml (xml)
(receive (_ stderr) (run-fail "era_check" xml)
"Prints helpful message in case tiny metadata given"
(with-temp-file-sized ((md "era.bin" 1024))
(receive (_ stderr) (run-fail "era_check" md)
(assert-starts-with "Metadata device/file too small. Is this binary metadata?" stderr))))
(define-scenario (era-check spot-accidental-xml-data)

View File

@@ -0,0 +1,9 @@
(library
(fail)
(export fail)
(import (chezscheme))
(define (fail msg)
(raise (condition
(make-error)
(make-message-condition msg)))))

View File

@@ -93,7 +93,8 @@
(fmt #t (cat (fn keys) nl))
(flush))
(for-each describe (cons '() (reverse (cdr (reverse keys)))) keys))
(unless (null? keys)
(for-each describe (cons '() (reverse (cdr (reverse keys)))) keys)))
(define (describe-scenarios keys)
(fmt-scenarios keys

View File

@@ -6,6 +6,7 @@
run-fail)
(import (chezscheme)
(fail)
(fmt fmt)
(logging)
(list-utils)
@@ -19,11 +20,6 @@
;;; we need for testing. So we use system, and redirect stderr and stdout to
;;; temporary files, and subsequently read them in. Messy, but fine for tests.
(define (fail msg)
(raise (condition
(make-error)
(make-message-condition msg))))
(define (build-command-line cmd-and-args)
(apply fmt #f (map dsp (intersperse " " cmd-and-args))))

View File

@@ -114,9 +114,9 @@
(thin-check "--clear-needs-check-flag" md)))
(define-scenario (thin-check tiny-metadata)
"Prints helpful message in case XML metadata given"
(with-thin-xml (xml)
(receive (_ stderr) (run-fail "thin_check" xml)
"Prints helpful message in case tiny metadata given"
(with-temp-file-sized ((md "thin.bin" 1024))
(receive (_ stderr) (run-fail "thin_check" md)
(assert-starts-with "Metadata device/file too small. Is this binary metadata?" stderr))))
(define-scenario (thin-check spot-accidental-xml-data)