sfos/ledger
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

ldg-texi.el now auto-generates regression tests

Browse source
This commit is contained in:
John Wiegley 2010-03-15 01:27:52 -04:00
parent a5d99cc9d3
commit 87ad6f52f8
2 changed files with 64 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
doc/ledger.texi
View file

@ -4107,4 +4107,19 @@ parser_t
@section General Utility @section General Utility
@c data: foo
@smallexample
2004/05/01 * Checking balance
Assets:Bank:Checking $1,000.00
Equity:Opening Balances
@end smallexample
@c smex utility-1: $LEDGER -f $foo bal
@smallexample
$1,000.00 Assets:Bank:Checking
$-1,000.00 Equity:Opening Balances
--------------------
0
@end smallexample
@bye @bye

67
lisp/ldg-texi.el
View file

@ -2,14 +2,16 @@
(defvar ledger-sample-doc-path "/Users/johnw/src/ledger/doc/sample.dat") (defvar ledger-sample-doc-path "/Users/johnw/src/ledger/doc/sample.dat")
(defvar ledger-normalization-args "--args-only --columns 80") (defvar ledger-normalization-args "--args-only --columns 80")
(defun ledger-texi-expand-examples () (defun ledger-texi-update-examples ()
(interactive) (interactive)
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^@c \\(\\(?:small\\)?example\\): \\(.*\\)" nil t) (while (re-search-forward "^@c \\(\\(?:sm\\)?ex\\) \\(\\S-+\\): \\(.*\\)" nil t)
(let ((section (match-string 1)) (let ((section (match-string 1))
(command (match-string 2)) (example-name (match-string 2))
(data-file ledger-sample-doc-path)) (command (match-string 3)) expanded-command
(data-file ledger-sample-doc-path)
input output)
(goto-char (match-end 0)) (goto-char (match-end 0))
(forward-line) (forward-line)
(when (looking-at "@\\(\\(?:small\\)?example\\)") (when (looking-at "@\\(\\(?:small\\)?example\\)")
@ -28,35 +30,64 @@
(search-forward (format "@c data: %s" label)) (search-forward (format "@c data: %s" label))
(re-search-forward "@\\(\\(?:small\\)?example\\)") (re-search-forward "@\\(\\(?:small\\)?example\\)")
(forward-line) (forward-line)
(let ((beg (point)) (let ((beg (point)))
content)
(re-search-forward "@end \\(\\(?:small\\)?example\\)") (re-search-forward "@end \\(\\(?:small\\)?example\\)")
(setq content (buffer-substring-no-properties (setq input (buffer-substring-no-properties
beg (match-beginning 0))) beg (match-beginning 0)))
(with-current-buffer (find-file-noselect data-file) (with-current-buffer (find-file-noselect data-file)
(erase-buffer) (erase-buffer)
(insert content) (insert input)
(save-buffer)))))) (save-buffer))))))
(if (string-match "\\$LEDGER" command) (setq expanded-command command)
(setq command (if (string-match "\\$LEDGER" expanded-command)
(setq expanded-command
(replace-match (replace-match
(format "%s -f \"%s\" %s" ledger-path (format "%s -f \"%s\" %s" ledger-path
data-file ledger-normalization-args) data-file ledger-normalization-args)
t t command))) t t expanded-command)))
(save-restriction (save-restriction
(narrow-to-region (point) (point)) (narrow-to-region (point) (point))
(shell-command command t (get-buffer-create " *ldg-texi*")) (shell-command expanded-command t (get-buffer-create " *ldg-texi*"))
(if (= (point-min) (point-max)) (if (= (point-min) (point-max))
(progn (progn
(push-mark nil t) (push-mark nil t)
(message "Command '%s' yielded no result at %d" (message "Command '%s' yielded no result at %d"
command (point)) expanded-command (point))
(ding)) (ding))
(setq output (buffer-string))
(goto-char (point-min)) (goto-char (point-min))
(insert "@" section ?\n) (let ((section-name (if (string= section "smex")
(goto-char (point-max)) "smallexample"
(unless (eolp) "example")))
(insert ?\n)) (insert "@" section-name ?\n)
(insert "@end " section ?\n))))))) (goto-char (point-max))
(unless (eolp)
(insert ?\n))
(insert "@end " section-name ?\n))))
;; Update the regression test associated with this example
(with-current-buffer
(find-file-noselect
(expand-file-name (concat example-name ".test")
"../test/manual"))
(erase-buffer)
(let ((case-fold-search nil))
(if (string-match "\\$LEDGER\\s-+" command)
(setq command (replace-match "" t t command)))
(if (string-match " -f \\$\\([-a-z]+\\)" command)
(setq command (replace-match "" t t command))))
(insert command ?\n)
(insert "<<<" ?\n)
(insert input)
(insert ">>>1" ?\n)
(insert output)
(insert ">>>2" ?\n)
(insert "=== 0" ?\n)
(save-buffer)
(kill-buffer (current-buffer)))))))
(provide 'ldg-texi)