ledger-test.el (4917B)
1 ;;; ledger-test.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org) 4 5 ;; This file is not part of GNU Emacs. 6 7 ;; This is free software; you can redistribute it and/or modify it under 8 ;; the terms of the GNU General Public License as published by the Free 9 ;; Software Foundation; either version 2, or (at your option) any later 10 ;; version. 11 ;; 12 ;; This is distributed in the hope that it will be useful, but WITHOUT 13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 15 ;; for more details. 16 ;; 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with GNU Emacs; see the file COPYING. If not, write to the 19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, 20 ;; MA 02110-1301 USA. 21 22 ;;; Commentary: 23 24 ;;; Code: 25 26 (declare-function ledger-mode "ledger-mode") ; TODO: fix this cyclic dependency 27 (require 'org) 28 (require 'outline) 29 30 (defgroup ledger-test nil 31 "Definitions for the Ledger testing framework" 32 :group 'ledger) 33 34 (defcustom ledger-source-directory "~/ledger/" 35 "Directory where the Ledger sources are located." 36 :type 'directory 37 :group 'ledger-test) 38 39 (defcustom ledger-test-binary "/Products/ledger/debug/ledger" 40 "Directory where the Ledger debug binary is located." 41 :type 'file 42 :group 'ledger-test) 43 44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45 46 (defun ledger-create-test () 47 "Create a regression test." 48 (interactive) 49 (save-restriction 50 (org-narrow-to-subtree) 51 (save-excursion 52 (let (text beg) 53 (goto-char (point-min)) 54 (forward-line 1) 55 (setq beg (point)) 56 (search-forward ":PROPERTIES:") 57 (goto-char (line-beginning-position)) 58 (setq text (buffer-substring-no-properties beg (point))) 59 (goto-char (point-min)) 60 (re-search-forward ":ID:\\s-+\\([^-]+\\)") 61 (find-file-other-window 62 (format "~/src/ledger/test/regress/%s.test" (match-string 1))) 63 (sit-for 0) 64 (insert text) 65 (goto-char (point-min)) 66 (while (not (eobp)) 67 (goto-char (line-beginning-position)) 68 (delete-char 3) 69 (forward-line 1)))))) 70 71 (defun ledger-test-org-narrow-to-entry () 72 (outline-back-to-heading) 73 (narrow-to-region (point) (progn (outline-next-heading) (point))) 74 (goto-char (point-min))) 75 76 (defun ledger-test-create () 77 (interactive) 78 (let ((uuid (org-entry-get (point) "ID"))) 79 (when (string-match "\\`\\([^-]+\\)-" uuid) 80 (let ((prefix (match-string 1 uuid)) 81 input output) 82 (save-restriction 83 (ledger-test-org-narrow-to-entry) 84 (goto-char (point-min)) 85 (while (re-search-forward "#\\+begin_src ledger" nil t) 86 (goto-char (match-end 0)) 87 (forward-line 1) 88 (let ((beg (point))) 89 (re-search-forward "#\\+end_src") 90 (setq input 91 (concat (or input "") 92 (buffer-substring beg (match-beginning 0)))))) 93 (goto-char (point-min)) 94 (while (re-search-forward ":OUTPUT:" nil t) 95 (goto-char (match-end 0)) 96 (forward-line 1) 97 (let ((beg (point))) 98 (re-search-forward ":END:") 99 (setq output 100 (concat (or output "") 101 (buffer-substring beg (match-beginning 0))))))) 102 (find-file-other-window 103 (expand-file-name (concat prefix ".test") 104 (expand-file-name "test/regress" 105 ledger-source-directory))) 106 (ledger-mode) 107 (if input 108 (insert input) 109 (insert "2012-03-17 Payee\n") 110 (insert " Expenses:Food $20\n") 111 (insert " Assets:Cash\n")) 112 (insert "\ntest reg\n") 113 (if output 114 (insert output)) 115 (insert "end test\n"))))) 116 117 (defun ledger-test-run () 118 (interactive) 119 (save-excursion 120 (goto-char (point-min)) 121 (when (re-search-forward "^test \\(.+?\\)\\( ->.*\\)?$" nil t) 122 (let ((command (expand-file-name ledger-test-binary)) 123 (args (format "--args-only --columns=80 --no-color -f \"%s\" %s" 124 buffer-file-name (match-string 1)))) 125 (setq args (replace-regexp-in-string "\\$sourcepath" 126 ledger-source-directory args)) 127 (kill-new args) 128 (message "Testing: ledger %s" args) 129 (let ((prev-directory default-directory)) 130 (cd ledger-source-directory) 131 (unwind-protect 132 (async-shell-command (format "\"%s\" %s" command args)) 133 (cd prev-directory))))))) 134 135 (provide 'ledger-test) 136 137 ;;; ledger-test.el ends here