IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

test-extras.scm: centralize (gnc:options->sxml)

Browse Source 
I think this is useful enough to be upgraded.
This commit is contained in:
Christopher Lam 2018-05-06 20:44:36 +08:00
parent c6032ac6ed
commit 8ddee96463
2 changed files with 39 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
gnucash/report/report-system/test/test-extras.scm
View File

@ -21,6 +21,8 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report report-system))
(use-modules (sxml simple))
(export pattern-streamer)
@ -33,6 +35,7 @@
(export tbl-ref)
(export tbl-ref->number)
(export gnc:options->sxml)
;;
;; Random report test related syntax and the like
;;
@ -154,3 +157,38 @@
(gnc:option-value option)))
expense-options))
(define (gnc:options->sxml uuid options prefix test-title)
;; uuid - str to locate report uuid
;; options object -> sxml tree
;; prefix - str describing tests e.g. "test-trep"
;; test-title: str describing each unit test e.g. "test disable filter"
;;
;; This function abstracts the report renderer. It also catches XML
;; parsing errors, dumping the options changed.
;;
;; It also dumps the render into /tmp/XX-YY.html where XX is the
;; test prefix and YY is the test title.
(let* ((template (gnc:find-report-template uuid))
(constructor (record-constructor <report>))
(report (constructor uuid "bar" options #t #t #f #f ""))
(renderer (gnc:report-template-renderer template))
(document (renderer report))
(sanitize-char (lambda (c)
(if (char-alphabetic? c) c #\-)))
(fileprefix (string-map sanitize-char prefix))
(filename (string-map sanitize-char test-title)))
(gnc:html-document-set-style-sheet! document (gnc:report-stylesheet report))
(if test-title
(gnc:html-document-set-title! document test-title))
(let* ((filename (format #f "/tmp/~a-~a.html" fileprefix filename))
(render (gnc:html-document-render document)))
(with-output-to-file filename
(lambda ()
(display render)))
(catch 'parser-error
(lambda () (xml->sxml render))
(lambda (k . args)
(format #t "*** XML error. see render output at ~a\n~a"
filename (gnc:html-render-options-changed options #t))
(throw k args))))))

21
gnucash/report/standard-reports/test/test-transaction.scm
View File

@ -91,24 +91,7 @@
;; It also catches XML parsing errors, dumping the options changed.
;;
;; It also dumps the render into /tmp/test-trep-XX.html where XX is the test title
(let* ((template (gnc:find-report-template trep-uuid))
(report (constructor trep-uuid "bar" options #t #t #f #f ""))
(renderer (gnc:report-template-renderer template))
(document (renderer report))
(filename (string-map (lambda (c) (if (char-alphabetic? c) c #\-)) test-title)))
(gnc:html-document-set-style-sheet! document (gnc:report-stylesheet report))
(if test-title
(gnc:html-document-set-title! document test-title))
(let* ((filename (format #f "/tmp/test-trep-~a.html" filename))
(render (gnc:html-document-render document))
(outfile (open-file filename "w")))
(display render outfile)
(close-output-port outfile)
(catch 'parser-error
(lambda () (xml->sxml render))
(lambda (k . args)
(test-assert k #f) ; XML parse error doesn't cause a crash but logs as a failure
(format #t "see render output at ~a\n~a" filename (gnc:html-render-options-changed options #t)))))))
(gnc:options->sxml trep-uuid options "test-trep" test-title))
(define (get-row-col sxml row col)
;; sxml, row & col (numbers or #f) -> list-of-string
@ -135,8 +118,6 @@
;; END CANDIDATES
;;
(define constructor (record-constructor <report>))
(define (set-option! options section name value)
(let ((option (gnc:lookup-option options section name)))
(if option