Merge Chris Lam's 'maint-test-net-charts' into maint.

gnucash/report/report-system/html-text.scm

@@ -200,7 +200,7 @@
      (lambda ()
        (for-each 
         (lambda (kvp)
-          (format #f "~a=~s " (car kvp) (cadr kvp)))
+          (format #t "~a=~s " (car kvp) (cadr kvp)))
         (cons (list 'src src)
               rest))))))
 

gnucash/report/report-system/test/test-extras.scm

@@ -32,8 +32,6 @@
 (export tbl-ref)
 (export tbl-ref->number)
 
-(export gnc:options->sxml)
-
 ;;
 ;; Table parsing
 ;;
@@ -85,15 +83,17 @@
 (define (tbl-ref->number tbl row-index column-index)
   (string->number (car (tbl-ref tbl row-index column-index))))
 
-
-(define (gnc:options->sxml uuid options prefix test-title)
+(export gnc:options->render)
+(define (gnc:options->render uuid options prefix test-title)
   ;; uuid - str to locate report uuid
-  ;; options object -> sxml tree
+  ;; options - gnc:options object
   ;; 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.
+  ;; outputs: string
+  ;;
+  ;; This function abstracts the report renderer, producing a string. It
+  ;; can be useful for reports which may not valid XML.
   ;;
   ;; It also dumps the render into /tmp/XX-YY.html where XX is the
   ;; test prefix and YY is the test title.
@@ -105,25 +105,33 @@
          (document (renderer report))
          (sanitize-char (lambda (c)
                           (if (or (char-alphabetic? c)
-                                  (char-numeric? c)) c #\-)))
-         (fileprefix (string-map sanitize-char prefix))
-         (filename (string-map sanitize-char test-title)))
+                                  (char-numeric? c)) c #\-))))
     (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
+    (let ((render (gnc:html-document-render document)))
+      (with-output-to-file (format #f "/tmp/~a-~a.html"
+                                   (string-map sanitize-char prefix)
+                                   (string-map sanitize-char test-title))
         (lambda ()
           (display render)))
-      (catch 'parser-error
-        (lambda () (xml->sxml render
-                              #:trim-whitespace? #t
-                              #:entities '((nbsp . "\xa0"))))
-        (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))))))
+      render)))
+
+(export gnc:options->sxml)
+(define (gnc:options->sxml uuid options prefix test-title)
+  ;; This functions calls the above gnc:options->render to render
+  ;; report.  Then report is converted to SXML.  It catches XML
+  ;; parsing errors, dumping the options changed.
+  (let ((render (gnc:options->render uuid options prefix test-title)))
+    (catch 'parser-error
+      (lambda () (xml->sxml render
+                            #:trim-whitespace? #t
+                            #:entities '((nbsp . "\xa0"))))
+      (lambda (k . args)
+        (format #t "*** XML error: ~a ~a\n~a"
+                prefix test-title
+                (gnc:html-render-options-changed options #t))
+        (throw k args)))))
 
 (export sxml->table-row-col)
 (define (sxml->table-row-col sxml tbl row col)

gnucash/report/standard-reports/test/CMakeLists.txt

@@ -7,6 +7,7 @@ set(scm_test_standard_reports_SOURCES
 )
 
 set(scm_test_with_srfi64_SOURCES
+  test-net-charts.scm
   test-transaction.scm
   test-income-gst.scm
 )

gnucash/report/standard-reports/test/test-net-charts.scm

@@ -0,0 +1,101 @@
+(use-modules (gnucash gnc-module))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report standard-reports net-barchart))
+(use-modules (gnucash report standard-reports net-linechart))
+(use-modules (gnucash report stylesheets))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (sxml simple))
+(use-modules (sxml xpath))
+(use-modules (system vm coverage))
+(use-modules (system vm vm))
+
+(define variant-alist
+  (list
+   (cons 'net-worth-barchart "cbba1696c8c24744848062c7f1cf4a72")
+   (cons 'net-worth-linechart "d8b63264186b11e19038001558291366")
+   (cons 'income-expense-barchart "80769921e87943adade887b9835a7685")
+   (cons 'income-expense-linechart "e533c998186b11e1b2e2001558291366")))
+
+(define (variant->uuid variant)
+  (cdr (assq variant variant-alist)))
+
+;; Explicitly set locale to make the report output predictable
+(setlocale LC_ALL "C")
+
+(define (run-test)
+  (test-runner-factory gnc:test-runner)
+  (test-begin "net-charts.scm")
+  (for-each (lambda (variant)
+              (null-test variant))
+            (map car variant-alist))
+  (for-each (lambda (variant)
+              (net-charts-test variant))
+            (map car variant-alist))
+  (test-end "net-charts.scm"))
+
+(define (options->render variant options test-title)
+  ;; options object -> string
+  ;; It also dumps the render into /tmp/test-net-charts-XX.html where XX is the test title
+  (gnc:options->render variant options "test-net-charts-~a" test-title))
+
+(define structure
+  (list "Root" (list (cons 'type ACCT-TYPE-ASSET))
+        (list "Asset"
+              (list "Bank"))
+        (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
+        (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
+        (list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))))
+
+(define (set-option! options section name value)
+  (let ((option (gnc:lookup-option options section name)))
+    (if option
+        (gnc:option-set-value option value)
+        (test-assert (format #f "wrong-option ~a ~a" section name) #f))))
+
+(define (null-test variant)
+  ;; This null-test tests for the presence of report.
+  (let* ((uuid (variant->uuid variant))
+         (options (gnc:make-report-options uuid)))
+    (test-assert (format #f "null-test: ~a" variant)
+      (options->render uuid options "null-test"))))
+
+
+;; the following tests are not ready yet
+;; unfortunately sxml parsing requires a very valid xhtml, which means
+;; <script>
+
+(define (net-charts-test variant)
+  (let* ((uuid (variant->uuid variant))
+         (env (create-test-env))
+         (account-alist (env-create-account-structure-alist env structure))
+         (bank (cdr (assoc "Bank" account-alist)))
+         (income (cdr (assoc "Income" account-alist)))
+         (expense (cdr (assoc "Expenses" account-alist)))
+         (equity (cdr (assoc "Equity" account-alist)))
+         (YEAR (gnc:time64-get-year (gnc:get-today))))
+
+    (define (default-testing-options)
+      (let ((options (gnc:make-report-options (variant->uuid variant))))
+        (set-option! options "Accounts" "Accounts" (list bank))
+        (set-option! options "General" "Start Date" (cons 'relative 'start-cal-year))
+        (set-option! options "General" "End Date" (cons 'relative 'end-cal-year))
+        options))
+
+    (env-transfer env 01 01 YEAR bank expense       5   #:description "desc-1" #:num "trn1" #:memo "memo-3")
+    (env-transfer env 21 02 YEAR income bank       10   #:description "desc-2" #:num "trn2" #:void-reason "void" #:notes "notes3")
+    (env-transfer env 11 02 YEAR income bank       29   #:description "desc-3" #:num "trn3"
+                  #:reconcile (cons #\c (gnc-dmy2time64 01 03 YEAR)))
+    (env-transfer env 01 02 YEAR bank expense      15   #:description "desc-4" #:num "trn4" #:notes "notes2" #:memo "memo-1")
+    (env-transfer env 10 03 YEAR bank expense      10   #:description "desc-5" #:num "trn5" #:void-reason "any")
+    (env-transfer env 10 03 YEAR expense bank      11   #:description "desc-6" #:num "trn6" #:notes "notes1")
+    (env-transfer env 10 04 YEAR income bank        8   #:description "desc-7" #:num "trn7" #:notes "notes1" #:memo "memo-2"
+                  #:reconcile (cons #\y (gnc-dmy2time64 01 03 YEAR)))
+
+    (let* ((options (default-testing-options)))
+      (test-assert (format #f "basic report exists: ~a" variant)
+        (options->render uuid options (format #f "net-charts-test ~a default options" variant))))))
+