tap-harness

#!guile -s
-*- scheme -*-
!#

(use-modules (ice-9 getopt-long)
             (test tap-harness))

(define *name*    'tap-harness)
(define *version* '((major . 0)
                    (minor . 0)
                    (patch . 1)))

(define (pp-version v)
  (string-join (map (compose number->string cdr) v) "."))

(define option-spec
  '((debug   (single-char #\D))
    (help    (single-char #\h))
    (verbose (single-char #\v))
    (version (single-char #\V))
    (exec    (single-char #\e) (value #t))))

(define opts (getopt-long (command-line) option-spec
                          #:stop-at-first-non-option #t))

(define (opt o)
  (option-ref opts o #f))

(define (arguments)
  (opt '()))

(define (with-arguments?)
  ((compose not zero? length) (arguments)))

(when (opt 'help)
  (newline)
  (format #t " Usage:   tap-harness [OPTION(s)...] [PROGRAM(s)...]~%")
  (newline)
  (format #t "  --help, -h             Print this help text.~%")
  (format #t "  --version, -V          Print version information about the program.~%")
  (format #t "  --debug, -D            Enable debugging output in the program.~%")
  (format #t "  --verbose, -v          Enable verbose harness operation.~%")
  (newline)
  (format #t "  --exec EXEC, -e EXEC   Run PROGRAM(s) via EXEC.~%")
  (newline)
  (quit 0))

(when (opt 'version)
  (format #t "~a version ~a~%" *name* (pp-version *version*))
  (quit 0))

(when (and (opt 'exec) (not (with-arguments?)))
  (format #t "~a: Option --exec (-e) requires non-option arguments to run.~%"
          *name*)
  (quit 1))

(define harness-callback
  (if (opt 'verbose)
      (make-harness-callback #:test render-parsed
                             #:plan render-parsed
                             #:diagnostic render-parsed
                             #:version render-parsed
                             #:bailout render-parsed)
      (make-harness-callback #:plan progress-plan
                             #:test progress-test
                             #:bailout render-parsed
                             #:completion progress-completion)))

(quit
 (harness-combined-result
  (if (with-arguments?)
      (harness-analyse ((if (opt 'debug)
                            pp-harness-state
                            identity) (harness-run #:run-programs (arguments)
                            #:runner (opt 'exec)
                            #:callback harness-callback))
                       #:pre-summary (lambda (_) (newline)))
      (harness-analyse ((if (opt 'debug)
                            pp-harness-state
                            identity) (harness-stdin harness-callback))
                       #:pre-summary (lambda (_) (newline))))))