thin-provisioning-tools/functional-tests/run-tests

67 lines
1.6 KiB
Plaintext
Raw Normal View History

#! /usr/bin/scheme-script
(import (rnrs)
(fmt fmt)
2017-08-15 20:37:45 +05:30
(functional-tests)
(cache-functional-tests)
(only (srfi s1 lists) break)
(srfi s8 receive)
2017-08-15 20:37:45 +05:30
(thin-functional-tests))
;;------------------------------------------------
(define (begins-with prefix xs)
(cond
((null? prefix) #t)
((null? xs) #f)
((eq? (car prefix) (car xs))
(begins-with (cdr prefix) (cdr xs)))
(else #f)))
(define (split-list xs sep)
(define (safe-cdr xs)
(if (null? xs) '() (cdr xs)))
(if (null? xs)
'()
(receive (p r) (break (lambda (c)
(eq? c sep))
xs)
(cons p (split-list (safe-cdr r) sep)))))
(define (string->syms str sep)
(map (lambda (cs)
(string->symbol
(list->string cs)))
(split-list (string->list str) sep)))
(define (mk-single-filter pattern)
(let ((prefix (string->syms pattern #\/)))
(lambda (keys)
(begins-with prefix keys))))
(define (mk-filter patterns)
(if (null? patterns)
; accept everything if no patterns
(lambda (_) #t)
; Otherwise accept tests that pass a pattern
(let ((filters (map mk-single-filter patterns)))
(fold-left (lambda (fn-a fn-b)
(lambda (keys)
(or (fn-a keys)
(fn-b keys))))
(car filters)
(cdr filters)))))
;;------------------------------------------------
2017-08-15 20:37:45 +05:30
(register-thin-tests)
(register-cache-tests)
(let ((pred (mk-filter (cdr (command-line)))))
(if (run-scenarios (filter pred (list-scenarios)))
(exit)
(exit #f)))
2017-08-15 20:37:45 +05:30