prove コマンドを何回も叩くのが面倒くさいなと思いつつ、でも fly-make とかはちょっとやり過ぎかなとも思って書いてみた。各バッファで初回実行時にだけ、テストの設定を聞かれる。
- モジュール(ディストリビューション)のトップディレクトリ (default:"Makefile.PL" が存在するディレクトリ)
- テストファイル(default: 呼び出したバッファがディレクトリ t 以下のものならそれ自身、そうでなければ、以下のうち最初に見つかったもの。(Hoge::Fuga::Foo の場合))
- Hoge-Fuga-Foo.t
- Fuga-Foo.t
- Foo.t
- オプション
二回目以降の実行では前回の設定が使われるが、前置引数をつけて呼び出すと、再度設定を聞かれる。
(require 'cl)
(defvar perl-prove-command "prove"
"prove コマンド")
(defvar perl-prove-option "-vt --nocolor"
"prove コマンドのデフォルトオプション")
(defvar perl-prove-mark-file "Makefile.PL"
"モジュールのトップと見なすディレクトリに存在するファイル")
(defvar perl-prove-include '("lib" "blib/lib" "t")
"インクルードパスに追加するモジュールトップディレクトリからの
相対パス")
;;; internal variable
(defvar perl-prove-settings nil)
(make-variable-buffer-local 'perl-prove-settings)
(defun perl-prove (arg)
"prove コマンドを実行する。
初回実行時に、ディストリビューションのトップディレクトリ、テストファ
イル、prove コマンドのオプションが問い合わせされる。ここで指定した
設定はバッファローカルに記憶され、次回以降は問い合わせ無く実効され
る。
前置引数をつけると、2回目以降であっても問い合わせされる。
"
(interactive "P")
(when (or arg (not perl-prove-settings))
(let*
((module-elements nil)
(path-elements
(reverse
(split-string
(file-name-sans-extension (buffer-file-name))
"/")))
(module-root
(file-name-as-directory
(read-directory-name
"Module Root: "
(loop
while path-elements
for path = (reduce (lambda (a b)
(concat b "/" a)) path-elements)
do
(when (and (file-directory-p path)
(file-exists-p
(concat path "/" perl-prove-mark-file)))
(push (pop module-elements) path-elements)
(return (file-name-as-directory path)))
(push (pop path-elements) module-elements))
nil t)))
(test-file
(if (string= (car module-elements) "t")
(buffer-file-name)
(let ((test-default
(loop for tfe on module-elements
for tf = (concat
module-root "t/"
(reduce (lambda (a b)
(concat a "-" b)) tfe)
".t")
when (file-exists-p tf) return tf
finally (return (concat module-root "t/")))))
(read-file-name
"Test: " test-default test-default))))
(opts
(read-string "Options: " perl-prove-option)))
(setq perl-prove-settings
(list (cons 'root module-root )
(cons 'test test-file )
(cons 'opts opts )))))
(compile
(concat
perl-prove-command
" " (cdr (assq 'opts perl-prove-settings))
(apply 'concat
(mapcar
(lambda (x)
(concat
" -I"
(expand-file-name
(concat (cdr (assq 'root perl-prove-settings)) x))))
perl-prove-include))
" " (file-relative-name (cdr (assq 'test perl-prove-settings))))))
(provide 'perl-prove)
perl-prove を使いやすいキーにバインドしておくとよいかも。
幾つか決めうちの実装があるけれど、自分で使う分には困らないので放置。実装が汚いのも、同じく放置。(^_^;
改造等は自由にやってください。
コメントする