Mona のテストをより気軽に実行する仕組み

mona

最近書いた Mona の API は TDD で開発したのでテストコードが付属している。
当然ながら Mona の API なので Mona 上にテスト結果が表示されるのだが

  • qemu 立ち上げる
  • qemu のウィンドウが最前面に現れる
  • テスト結果を目視
  • qemu 終了する

と大変面倒で、気軽にテストを「実行できない」・「書きたくない」となりつつあった。


そこでホスト OS 上で make check とやると以下のように結果のみが表示される仕組みを作った。


やっている事は以下の通り。qemu を daemon として立ち上げるところが肝。

  • qemu を バックグラウンドで立ち上げる
    • --daemonize -nographic -pidfile /tmp/mona.pid -no-kqemu
  • Mona のテストフレームワークがシリアルポートにテスト結果を書く
    • これがホスト OS のファイルに出力される
  • Mosh で書いたスクリプトでテスト結果を待ち受けて出力


個人的な大切なポイントは

  • これくらいのことが自前の Mosh で出来るようになった事。
  • テスト結果が red/green で表示される事。(mosh test) ライブラリも同様。

の 2 点。

コード

(import (rnrs)
        (mosh)
        (mosh control)
        (only (mosh concurrent) sleep)
        (mosh process)
        (mosh file))

(define-syntax with-color
  (lambda (x)
    (syntax-case x ()
      [(_ color expr more ...)
       (if (string=? (host-os) "win32")
           #'(begin expr more ...)
           #'(dynamic-wind
                 (lambda () (display color))
                 (lambda () expr more ...)
                 (lambda () (display "\x1b;[m")))]))))

(define-syntax with-color-green
  (lambda (x)
    (syntax-case x ()
      [(_ expr more ...)
       #'(with-color "\x1b;[0;32m" expr more ...)])))

(define-syntax with-color-red
  (lambda (x)
    (syntax-case x ()
      [(_ expr more ...)
       #'(with-color "\x1b;[0;31m" expr more ...)])))

(define test-results-file "/tmp/mona_serial.log")
(define pid-file "/tmp/mona.pid")

(let loop ()
  (let1 text (file->string test-results-file)
    (when (#/all tests done/ text)
      (let* ([results (string-split text #\newline)]
             [passed (filter #/test passed/ results)]
             [each-errors (filter #/MUnit:/ results)]
             [failed (filter #/failed/ results)])
        (cond
         [(and (null? each-errors) (null? failed))
          (with-color-green
           (for-each print passed))]
         [else
          (with-color-red
           (for-each print each-errors)
           (for-each print failed))]))
      (spawn "kill" (list (number->string (read (open-input-file pid-file)))))
      (exit 0))
    (sleep 100)
    (loop)))