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

#! /usr/bin/scheme-script

(import (rnrs)
        (fmt fmt)
        (functional-tests)
        (cache-functional-tests)
        (only (srfi s1 lists) break)
        (srfi s8 receive)
        (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)))))

;;------------------------------------------------

(register-thin-tests)
(register-cache-tests)

(let ((pred (mk-filter (cdr (command-line)))))
 (if (run-scenarios (filter pred (list-scenarios)))
    (exit)
    (exit #f)))