gnucash maint: Multiple changes pushed
Geert Janssens
gjanssens at code.gnucash.org
Thu Jan 31 13:31:06 EST 2019
Updated via https://github.com/Gnucash/gnucash/commit/d048caed (commit)
via https://github.com/Gnucash/gnucash/commit/40a0bfd9 (commit)
via https://github.com/Gnucash/gnucash/commit/7e860374 (commit)
via https://github.com/Gnucash/gnucash/commit/412d797e (commit)
via https://github.com/Gnucash/gnucash/commit/59c78c26 (commit)
via https://github.com/Gnucash/gnucash/commit/af0d7bd9 (commit)
via https://github.com/Gnucash/gnucash/commit/b0c5381c (commit)
via https://github.com/Gnucash/gnucash/commit/c5915776 (commit)
from https://github.com/Gnucash/gnucash/commit/aab9bb59 (commit)
commit d048caeda30ca841befdedcfc1e398fc74d7d5a7
Author: Carsten Rinke <carsten.rinke at gmx.de>
Date: Fri Oct 12 18:29:26 2018 +0200
improved logging for HTML table tests
diff --git a/gnucash/report/report-system/test/test-report-html.scm b/gnucash/report/report-system/test/test-report-html.scm
index 9d8bc1a..345bf8e 100644
--- a/gnucash/report/report-system/test/test-report-html.scm
+++ b/gnucash/report/report-system/test/test-report-html.scm
@@ -608,8 +608,8 @@ HTML Document Title</title></head><body></body>\n\
(test-begin "HTML Tables - without style sheets")
- (test-begin "Row Manipulations")
- (test-begin "Append Rows")
+ (test-begin "HTML Table - Row Manipulations")
+ (test-begin "HTML Table - Append Rows")
(let (
(test-doc (gnc:make-html-document))
(test-table (gnc:make-html-table))
@@ -622,17 +622,17 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-table-set-caption! test-table #t)
(gnc:html-table-append-row! test-table "Row 1")
(gnc:html-table-append-row! test-table "Row 2")
- (test-equal "Check Num Rows after append row"
+ (test-equal "HTML Table - Check Num Rows after append row"
2
(gnc:html-table-num-rows test-table)
)
- (test-equal "Check data after append row"
+ (test-equal "HTML Table - Check data after append row"
'(("Row 2") ("Row 1"))
(gnc:html-table-data test-table)
)
)
- (test-end "Append Rows")
- (test-begin "Remove Rows")
+ (test-end "HTML Table - Append Rows")
+ (test-begin "HTML Table - Remove Rows")
(let (
(test-doc (gnc:make-html-document))
(test-table (gnc:make-html-table))
@@ -646,19 +646,19 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-table-append-row! test-table "Row 1")
(gnc:html-table-append-row! test-table "Row 2")
(gnc:html-table-remove-last-row! test-table)
- (test-equal "Check Num Rows after remove row"
+ (test-equal "HTML Table - Check Num Rows after remove row"
1
(gnc:html-table-num-rows test-table)
)
- (test-equal "Check data after remove row"
+ (test-equal "HTML Table - Check data after remove row"
'(("Row 1"))
(gnc:html-table-data test-table)
)
(gnc:html-table-remove-last-row! test-table)
- (test-equal "Negative Test: Remove non-existing rows" '() (gnc:html-table-remove-last-row! test-table))
+ (test-equal "HTML Table - Negative Test: Remove non-existing rows" '() (gnc:html-table-remove-last-row! test-table))
)
- (test-end "Remove Rows")
- (test-begin "Prepend Rows")
+ (test-end "HTML Table - Remove Rows")
+ (test-begin "HTML Table - Prepend Rows")
(let (
(test-doc (gnc:make-html-document))
(test-table (gnc:make-html-table))
@@ -674,18 +674,18 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-table-prepend-row! test-table "Row 0")
(gnc:html-table-prepend-row! test-table "Row -1")
(gnc:html-table-prepend-row! test-table '("r-2-c1" "r-2-c2"))
- (test-equal "Check Num Rows after prepend row"
+ (test-equal "HTML Table - Check Num Rows after prepend row"
5
(gnc:html-table-num-rows test-table)
)
- (test-equal "Check data after prepend row"
+ (test-equal "HTML Table - Check data after prepend row"
'(("Row 2") ("Row 1") ("Row 0") ("Row -1") ("r-2-c1" "r-2-c2"))
(gnc:html-table-data test-table)
)
)
- (test-end "Prepend Rows")
- (test-end "Row Manipulations")
- (test-begin "Cell Access and Edit")
+ (test-end "HTML Table - Prepend Rows")
+ (test-end "HTML Table - Row Manipulations")
+ (test-begin "HTML Table - Cell Access and Edit")
(let (
(test-doc (gnc:make-html-document))
(test-table (gnc:make-html-table))
@@ -699,7 +699,7 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-table-append-row! test-table "Row 1")
(gnc:html-table-append-row! test-table "Row 2")
(gnc:html-table-append-row! test-table "Row 3")
- (test-equal "Check Cell Access"
+ (test-equal "HTML Table - Check Cell Access"
"Row 1Row 2Row 3"
(string-append
(gnc:html-table-get-cell test-table 0 0)
@@ -707,7 +707,7 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-table-get-cell test-table 2 0)
)
)
- (test-assert "Negative Test: Check Cell Access - non-existing cells"
+ (test-assert "HTML Table - Negative Test: Check Cell Access - non-existing cells"
(not
(or (gnc:html-table-get-cell test-table 1 1)
(gnc:html-table-get-cell test-table -1 0)
@@ -715,8 +715,8 @@ HTML Document Title</title></head><body></body>\n\
)
)
)
- (test-end "Cell Access and Edit")
- (test-begin "Append Columns")
+ (test-end "HTML Table - Cell Access and Edit")
+ (test-begin "HTML Table - Append Columns")
(let (
(test-doc (gnc:make-html-document))
(test-table (gnc:make-html-table))
@@ -731,21 +731,21 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-table-append-row! test-table '("r2c1" "r2c2" "r2c3"))
(gnc:html-table-append-row! test-table '("r3c1" "r3c2"))
(gnc:html-table-append-column! test-table '("r1c4" "r2c4" "r3c4" "r4c4"))
- (test-equal "Check Num Rows after append column"
+ (test-equal "HTML Table - Check Num Rows after append column"
4
(gnc:html-table-num-rows test-table)
)
- (test-equal "Check data after append column"
+ (test-equal "HTML Table - Check data after append column"
'((#f #f #f "r4c4") ("r3c1" "r3c2" #f "r3c4") ("r2c1" "r2c2" "r2c3" "r2c4") ("r1c1" #f #f "r1c4"))
(gnc:html-table-data test-table)
)
- (test-equal "Check Cell Access after append column"
+ (test-equal "HTML Table - Check Cell Access after append column"
"r3c2"
(gnc:html-table-get-cell test-table 2 1)
)
)
- (test-end "Append Columns")
- (test-begin "Table Rendering")
+ (test-end "HTML Table - Append Columns")
+ (test-begin "HTML Table - Table Rendering")
(let (
(test-doc (gnc:make-html-document))
(test-table (gnc:make-html-table))
@@ -759,7 +759,7 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-table-append-row! test-table "Row 1")
(gnc:html-table-append-row! test-table "Row 2")
(gnc:html-table-append-column! test-table '("Col A" "Col B"))
- (test-equal "Check table rendering result"
+ (test-equal "HTML Table - Check table rendering result"
"<table><caption><boolean> #t</caption>\n\
<tbody>\
<tr><td><string> Row 1</td>\n<td><string> Col A</td>\n</tr>\n\
@@ -773,7 +773,7 @@ HTML Document Title</title></head><body></body>\n\
)
)
)
- (test-end "Table Rendering")
+ (test-end "HTML Table - Table Rendering")
(test-end "HTML Tables - without style sheets")
)
commit 40a0bfd9797ae169ee6ee69fb222a9ae43edd51a
Author: Carsten Rinke <carsten.rinke at gmx.de>
Date: Mon Sep 3 07:54:02 2018 +0200
Bug796827 - Report HTML - it is not possible to suppress the document title
includes update of test-report-html.scm (and CMakeLists.txt)
diff --git a/gnucash/report/report-system/html-document.scm b/gnucash/report/report-system/html-document.scm
index e8888ba..f7a3d39 100644
--- a/gnucash/report/report-system/html-document.scm
+++ b/gnucash/report/report-system/html-document.scm
@@ -147,8 +147,7 @@
(gnc:html-document-style-stack doc))
;; push it
(gnc:html-document-push-style doc (gnc:html-document-style doc))
- (if (not (string-null? title))
- (gnc:report-render-starting (gnc:html-document-title doc)))
+ (gnc:report-render-starting (gnc:html-document-title doc))
(if headers?
(begin
;;This is the only place where <html> appears
@@ -161,9 +160,8 @@
(push "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n")
(if style-text
(push (list "</style>" style-text "<style type=\"text/css\">\n")))
- (let ((title (gnc:html-document-title doc)))
- (if title
- (push (list "</title>" title "<title>\n"))))
+ (if (not (string-null? title))
+ (push (list "</title>" title "<title>\n")))
(push "</head>")))
;; this lovely little number just makes sure that <body>
@@ -173,17 +171,15 @@
;; now render the children
(for-each
(lambda (child)
- (begin
(push (gnc:html-object-render child doc))
(set! work-done (+ 1 work-done))
- (gnc:report-percent-done (* 100 (/ work-done work-to-do)))))
+ (gnc:report-percent-done (* 100 (/ work-done work-to-do))))
objs)
(push "</body>\n")
(if headers?
- (begin
- (push "</html>\n")))
+ (push "</html>\n"))
(gnc:report-finished)
(gnc:html-document-pop-style doc)
diff --git a/gnucash/report/report-system/test/test-report-html.scm b/gnucash/report/report-system/test/test-report-html.scm
index 1e8bda4..9d8bc1a 100644
--- a/gnucash/report/report-system/test/test-report-html.scm
+++ b/gnucash/report/report-system/test/test-report-html.scm
@@ -20,13 +20,6 @@
(test-end "Testing/Temporary/test-report-html")
)
-(define html-doc-header-empty-title
-"<html>\n\
-<head>\n\
-<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
-<title>\n\
-</title></head><body>")
-
(define html-doc-header-no-title
"<html>\n\
<head>\n\
@@ -59,20 +52,14 @@
(test-assert "HTML Document - default no headline" (not (gnc:html-document-headline test-doc)))
(test-assert "HTML Document - default no objects" (null? (gnc:html-document-objects test-doc)))
- (test-equal "HTML Document - Render empty body (without enhancement bug 796832)"
- (string-append html-doc-header-empty-title html-doc-tail)
- (gnc:html-document-render test-doc)
- )
-
- (test-expect-fail 2)
- (test-equal "HTML Document - Render without title (Bug 796827)"
+ (test-equal "HTML Document - Render empty body"
(string-append html-doc-header-no-title html-doc-tail)
(gnc:html-document-render test-doc)
)
- (test-equal "HTML Document - Render without header (Bug 796826)"
+ (test-equal "HTML Document - Render empty body without header"
html-doc-no-header-empty-body
- (gnc:html-document-render test-doc '())
+ (gnc:html-document-render test-doc #f)
)
(gnc:html-document-set-title! test-doc "HTML Document Title")
@@ -97,7 +84,7 @@ HTML Document Title</title></head><body></body>\n\
(test-begin "HTML Object Definitions for literals")
(test-equal "HTML Object for Strings"
- (string-append html-doc-header-empty-title "<string> HTML Plain Text Body" html-doc-tail)
+ (string-append html-doc-header-no-title "<string> HTML Plain Text Body" html-doc-tail)
(let (
(test-doc (gnc:make-html-document))
)
@@ -111,7 +98,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Object for Numbers"
- (string-append html-doc-header-empty-title "<number> 1234567890" html-doc-tail)
+ (string-append html-doc-header-no-title "<number> 1234567890" html-doc-tail)
(let (
(test-doc (gnc:make-html-document))
)
@@ -125,7 +112,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Object for Boolean TRUE"
- (string-append html-doc-header-empty-title "<boolean> #t" html-doc-tail)
+ (string-append html-doc-header-no-title "<boolean> #t" html-doc-tail)
(let (
(test-doc (gnc:make-html-document))
)
@@ -138,9 +125,10 @@ HTML Document Title</title></head><body></body>\n\
)
)
- (test-expect-fail 1)
- (test-equal "HTML Object for Boolean FALSE - Bug 796828"
- (string-append html-doc-header-empty-title "<boolean> #f" html-doc-tail)
+ ;; NOTE: The following test for Boolean FALSE is correct.
+ ;; #f values are used to indicate empty cells and will be converted to spaces
+ (test-equal "HTML Object for Boolean FALSE"
+ (string-append html-doc-header-no-title "<string> " html-doc-tail)
(let (
(test-doc (gnc:make-html-document))
)
@@ -154,7 +142,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Object for generic types"
- (string-append html-doc-header-empty-title "<generic> (a b c d)" html-doc-tail)
+ (string-append html-doc-header-no-title "<generic> (a b c d)" html-doc-tail)
(let (
(test-doc (gnc:make-html-document))
)
@@ -177,7 +165,7 @@ HTML Document Title</title></head><body></body>\n\
(test-begin "HTML Text Objects")
(test-equal "HTML Text Object - no markup"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<string> HTML Text Body - Part 1.<string> Part 2."
html-doc-tail
)
@@ -197,7 +185,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - with number in decimal format"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"HTML Text with number <number> 7 in decimal format."
html-doc-tail
)
@@ -219,7 +207,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - with number in float format"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"HTML Text with number <number> 8.8 in float format."
html-doc-tail
)
@@ -241,7 +229,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - with boolean format"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"HTML Text with boolean <boolean> #f."
html-doc-tail
)
@@ -263,7 +251,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - with literal format"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"HTML Text with literal <string> text123."
html-doc-tail
)
@@ -285,7 +273,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - with generic format"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"HTML Text with generic <generic> (a b c d)."
html-doc-tail
)
@@ -307,7 +295,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Paragraph"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<p><string> HTML Text Paragraph</p>\n"
html-doc-tail
)
@@ -326,7 +314,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Typewriter"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<tt><string> HTML Text Typewriter</tt>\n"
html-doc-tail
)
@@ -345,7 +333,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Emphasized"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<em><string> HTML Text Emphasized</em>\n"
html-doc-tail
)
@@ -364,7 +352,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Bold"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<b><string> HTML Text Bold</b>\n"
html-doc-tail
)
@@ -383,7 +371,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Italic"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<i><string> HTML Text Italic</i>\n"
html-doc-tail
)
@@ -402,7 +390,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Heading1"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<h1><string> HTML Text Heading1</h1>\n"
html-doc-tail
)
@@ -421,7 +409,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Heading2"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<h2><string> HTML Text Heading2</h2>\n"
html-doc-tail
)
@@ -440,7 +428,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Heading3"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<h3><string> HTML Text Heading3</h3>\n"
html-doc-tail
)
@@ -459,7 +447,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Linebreak"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<br /><string> HTML Text Linebreak"
html-doc-tail
)
@@ -479,7 +467,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Headrow"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<hr /><string> HTML Text Headrow"
html-doc-tail
)
@@ -499,7 +487,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Unsorted List"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<string> HTML Text Unsorted List<ul><li><string> Item1</li>\n<li><string> Item2</li>\n</ul>\n"
html-doc-tail
)
@@ -519,7 +507,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Anchor Link"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<a href=\"HTML Text Anchor Link\"><string> HTML Text Anchor Description</a>\n"
html-doc-tail
)
@@ -541,7 +529,7 @@ HTML Document Title</title></head><body></body>\n\
)
(test-equal "HTML Text Object - Image"
- (string-append html-doc-header-empty-title
+ (string-append html-doc-header-no-title
"<img src=\"http://www.gnucash.org/images/banner5.png\" width=\"72\" height=\"48\" alt=\"GunCash web site\" />"
html-doc-tail
)
@@ -573,15 +561,14 @@ HTML Document Title</title></head><body></body>\n\
(test-begin "HTML Cells")
- (test-expect-fail 1)
- (test-equal "HTML Cell Creation - Bug 796828"
+ (test-equal "HTML Cell Creation"
"<tag rowspan=\"2\" colspan=\"3\">\
<string> HTML Table Cell\
<string> obj1\
<string> obj2<number> 123\
<boolean> #t\
-<boolean> #f\
+<string> \
<generic> (a b c d)</tag>\n"
(let (
@@ -692,7 +679,6 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-table-num-rows test-table)
)
(test-equal "Check data after prepend row"
-
'(("Row 2") ("Row 1") ("Row 0") ("Row -1") ("r-2-c1" "r-2-c2"))
(gnc:html-table-data test-table)
)
commit 7e86037418a40f8b9e1bc7a933eec2569afeafea
Author: Carsten Rinke <carsten.rinke at gmx.de>
Date: Mon Sep 3 06:59:55 2018 +0200
Bug796826 - Report HTML - not possible to suppress the document header
diff --git a/gnucash/report/report-system/html-document.scm b/gnucash/report/report-system/html-document.scm
index 6978ac0..e8888ba 100644
--- a/gnucash/report/report-system/html-document.scm
+++ b/gnucash/report/report-system/html-document.scm
@@ -128,7 +128,7 @@
;; returns the html document as a string, I think.
(define (gnc:html-document-render doc . rest)
(let ((stylesheet (gnc:html-document-style-sheet doc))
- (headers? (if (null? rest) #f (if (car rest) #t #f)))
+ (headers? (if (null? rest) #t (if (car rest) #t #f)))
(style-text (gnc:html-document-style-text doc))
)
(if stylesheet
@@ -149,7 +149,7 @@
(gnc:html-document-push-style doc (gnc:html-document-style doc))
(if (not (string-null? title))
(gnc:report-render-starting (gnc:html-document-title doc)))
- (if (not (null? headers?))
+ (if headers?
(begin
;;This is the only place where <html> appears
;;with the exception of 2 reports:
@@ -164,11 +164,11 @@
(let ((title (gnc:html-document-title doc)))
(if title
(push (list "</title>" title "<title>\n"))))
- (push "</head>")
+ (push "</head>")))
- ;; this lovely little number just makes sure that <body>
- ;; attributes like bgcolor get included
- (push ((gnc:html-markup/open-tag-only "body") doc))))
+ ;; this lovely little number just makes sure that <body>
+ ;; attributes like bgcolor get included
+ (push ((gnc:html-markup/open-tag-only "body") doc))
;; now render the children
(for-each
@@ -179,9 +179,10 @@
(gnc:report-percent-done (* 100 (/ work-done work-to-do)))))
objs)
- (if (not (null? headers?))
+ (push "</body>\n")
+
+ (if headers?
(begin
- (push "</body>\n")
(push "</html>\n")))
(gnc:report-finished)
commit 412d797eae74a2debe8f33d791ec8df39ea36000
Author: Carsten Rinke <carsten.rinke at gmx.de>
Date: Mon Sep 3 08:26:17 2018 +0200
Bug796829 - Report HTML - HTML table rows are prepended not as list elements
includes update of test-report-html.scm (and CMakeLists.txt)
diff --git a/gnucash/report/report-system/html-table.scm b/gnucash/report/report-system/html-table.scm
index 971e13d..357881b 100644
--- a/gnucash/report/report-system/html-table.scm
+++ b/gnucash/report/report-system/html-table.scm
@@ -364,8 +364,9 @@
(define (gnc:html-table-prepend-row! table newrow)
(let* ((dd (gnc:html-table-data table))
(current-num-rows (gnc:html-table-num-rows table))
- (new-num-rows (+ current-num-rows 1)))
- (set! dd (append dd (list newrow)))
+ (new-num-rows (+ current-num-rows 1))
+ (newrow-list (if (list? newrow) newrow (list newrow))))
+ (set! dd (append dd (list newrow-list)))
(gnc:html-table-set-num-rows-internal!
table
new-num-rows)
diff --git a/gnucash/report/report-system/test/test-report-html.scm b/gnucash/report/report-system/test/test-report-html.scm
index 3bd7b44..1e8bda4 100644
--- a/gnucash/report/report-system/test/test-report-html.scm
+++ b/gnucash/report/report-system/test/test-report-html.scm
@@ -686,13 +686,14 @@ HTML Document Title</title></head><body></body>\n\
(gnc:html-table-prepend-row! test-table "Row 1")
(gnc:html-table-prepend-row! test-table "Row 0")
(gnc:html-table-prepend-row! test-table "Row -1")
+ (gnc:html-table-prepend-row! test-table '("r-2-c1" "r-2-c2"))
(test-equal "Check Num Rows after prepend row"
- 4
+ 5
(gnc:html-table-num-rows test-table)
)
- (test-expect-fail 1)
- (test-equal "Check data after prepend row - Bug 796829"
- '(("Row 2") ("Row 1") ("Row 0") ("Row -1"))
+ (test-equal "Check data after prepend row"
+
+ '(("Row 2") ("Row 1") ("Row 0") ("Row -1") ("r-2-c1" "r-2-c2"))
(gnc:html-table-data test-table)
)
)
commit 59c78c2668c47232fe960f353c22b1f2a8aefd7a
Author: Carsten Rinke <carsten.rinke at gmx.de>
Date: Thu Sep 6 20:09:51 2018 +0200
Bug796831 - Report-HTML - append table column correctly
diff --git a/gnucash/report/report-system/html-table.scm b/gnucash/report/report-system/html-table.scm
index 97615b6..971e13d 100644
--- a/gnucash/report/report-system/html-table.scm
+++ b/gnucash/report/report-system/html-table.scm
@@ -495,7 +495,7 @@
(new-suffix (list element)))
(do
((i current-width (+ i 1)))
- ((< i width) #f)
+ ((>= 1 (- width i)))
(set! new-suffix (cons #f new-suffix)))
(append row new-suffix)))
diff --git a/gnucash/report/report-system/test/test-report-html.scm b/gnucash/report/report-system/test/test-report-html.scm
index a67e43a..3bd7b44 100644
--- a/gnucash/report/report-system/test/test-report-html.scm
+++ b/gnucash/report/report-system/test/test-report-html.scm
@@ -740,20 +740,20 @@ HTML Document Title</title></head><body></body>\n\
;; col-headers must be #f or a list
(gnc:html-table-set-row-headers! test-table #t)
(gnc:html-table-set-caption! test-table #t)
- (gnc:html-table-append-row! test-table "Row 1")
- (gnc:html-table-append-row! test-table "Row 2")
- (gnc:html-table-append-column! test-table '("Col A" "Col B" "Col C"))
+ (gnc:html-table-append-row! test-table "r1c1")
+ (gnc:html-table-append-row! test-table '("r2c1" "r2c2" "r2c3"))
+ (gnc:html-table-append-row! test-table '("r3c1" "r3c2"))
+ (gnc:html-table-append-column! test-table '("r1c4" "r2c4" "r3c4" "r4c4"))
(test-equal "Check Num Rows after append column"
- 3
+ 4
(gnc:html-table-num-rows test-table)
)
- (test-expect-fail 2)
- (test-equal "Check data after append column - Bug"
- '((" " "Col C") ("Row 2" "Col B") ("Row 1" "Col A"))
+ (test-equal "Check data after append column"
+ '((#f #f #f "r4c4") ("r3c1" "r3c2" #f "r3c4") ("r2c1" "r2c2" "r2c3" "r2c4") ("r1c1" #f #f "r1c4"))
(gnc:html-table-data test-table)
)
- (test-equal "Check Cell Access after append column - Bug 796831"
- "Col C"
+ (test-equal "Check Cell Access after append column"
+ "r3c2"
(gnc:html-table-get-cell test-table 2 1)
)
)
commit af0d7bd9f57dd9578a57640cc2e93a8f0b183903
Author: Carsten Rinke <carsten.rinke at gmx.de>
Date: Sun Sep 2 15:39:29 2018 +0200
test-report-html.scm reformatted after review PR#391 (major update)
diff --git a/gnucash/report/report-system/test/test-report-html.scm b/gnucash/report/report-system/test/test-report-html.scm
index 11a265a..a67e43a 100644
--- a/gnucash/report/report-system/test/test-report-html.scm
+++ b/gnucash/report/report-system/test/test-report-html.scm
@@ -12,369 +12,781 @@
(test-begin "Testing/Temporary/test-report-html")
;; if (test-runner-factory gnc:test-runner) is commented out, this
;; will create Testing/Temporary/test-report-html.log
- (test-assert "HTML Document Definition" (test-check1))
- (test-assert "HTML Objects Definition for literals" (test-check2))
- (test-assert "HTML Text Object" (test-check3))
- (test-assert "HTML Table Cell" (test-check4))
- (test-assert "HTML Table" (test-check5))
+ (test-html-document-defintion)
+ (test-html-objects-definition-for-literals)
+ (test-html-objects)
+ (test-html-cells)
+ (test-html-table)
(test-end "Testing/Temporary/test-report-html")
)
-;; -----------------------------------------------------------------------
-
-(define (test-check1)
- (let (
- (test-doc (gnc:make-html-document))
- )
- (and
- (gnc:html-document? test-doc)
- (not (gnc:html-document-style-sheet test-doc))
- (null? (gnc:html-document-style-stack test-doc))
- (gnc:html-style-table? (gnc:html-document-style test-doc))
- (not (gnc:html-document-style-text test-doc))
- (string-null? (gnc:html-document-title test-doc))
- (not (gnc:html-document-headline test-doc))
- (null? (gnc:html-document-objects test-doc))
- (string=?
- (gnc:html-document-render test-doc)
+(define html-doc-header-empty-title
"<html>\n\
<head>\n\
<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
<title>\n\
-</title></head><body></body>\n\
-</html>\n")
- ;; BUG?:
- ;; this code looks ugly
- ;;<html>
- ;;<head>
- ;;<meta http-equiv="content-type" content="text/html; charset=utf-8" />
- ;;<title>
- ;;</title></head><body></body>
- ;;</html>
-
- ;; BUG?:
- ;; There is no way to suppress the header,
- ;; (not (null? headers?)) is always true
-
- ;; BUG?:
- ;; There is no way to suppress the title, (if (title)) is always true
- ;; BUG?:
- ;; title is already defined, no reason to make a (let) statement
- ;; so this
- ;; (let ((title (gnc:html-document-title doc)))
- ;; (if title
- ;; (push (list "</title>" title "<title>\n"))))
- ;; should be this
- ;; (if (not (string-null? title))
- ;; (push (list "</title>" title "<title>\n")))
-
- (gnc:html-document-set-title! test-doc "HTML Document Title")
- (string=?
- (gnc:html-document-render test-doc)
+</title></head><body>")
+
+(define html-doc-header-no-title
"<html>\n\
<head>\n\
<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
-<title>\n\
-HTML Document Title</title></head><body></body>\n\
+</head><body>")
+
+(define html-doc-no-header-empty-body
+"<body></body>\n")
+
+(define html-doc-tail
+"</body>\n\
</html>\n")
- )
- )
-)
;; -----------------------------------------------------------------------
-(define (test-check2)
+(define (test-html-document-defintion)
+
+ (test-begin "HTML Document - Basic Creation")
+
(let (
(test-doc (gnc:make-html-document))
)
-
- (gnc:html-document-append-objects! test-doc
- (list
- (gnc:make-html-object "HTML Plain Text Body")
- (gnc:make-html-object 1234567890)
- (gnc:make-html-object #t)
- (gnc:make-html-object #f)
- (gnc:make-html-object '(a b c d))
- )
+
+ (test-assert "HTML Document - check predicate" (gnc:html-document? test-doc))
+ (test-assert "HTML Document - default no stylesheet" (not (gnc:html-document-style-sheet test-doc)))
+ (test-assert "HTML Document - default no style stack" (null? (gnc:html-document-style-stack test-doc)))
+ (test-assert "HMTL Document - check style table predicate" (gnc:html-style-table? (gnc:html-document-style test-doc)))
+ (test-assert "HTML Document - default no style text" (not (gnc:html-document-style-text test-doc)))
+ (test-assert "HTML Document - default no title" (string-null? (gnc:html-document-title test-doc)))
+ (test-assert "HTML Document - default no headline" (not (gnc:html-document-headline test-doc)))
+ (test-assert "HTML Document - default no objects" (null? (gnc:html-document-objects test-doc)))
+
+ (test-equal "HTML Document - Render empty body (without enhancement bug 796832)"
+ (string-append html-doc-header-empty-title html-doc-tail)
+ (gnc:html-document-render test-doc)
)
- (string=?
+ (test-expect-fail 2)
+ (test-equal "HTML Document - Render without title (Bug 796827)"
+ (string-append html-doc-header-no-title html-doc-tail)
(gnc:html-document-render test-doc)
+ )
+
+ (test-equal "HTML Document - Render without header (Bug 796826)"
+ html-doc-no-header-empty-body
+ (gnc:html-document-render test-doc '())
+ )
+
+ (gnc:html-document-set-title! test-doc "HTML Document Title")
+ (test-equal "HTML Document - Render with title"
"<html>\n\
<head>\n\
<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
<title>\n\
-</title></head><body><string> HTML Plain Text Body<number> 1234567890\
-<boolean> #t<string> <generic> (a b c d)</body>\n\
-</html>\n")
- ;; BUG: it is not possible to create a boolean false object
- ;; instead a string place holder is created
+HTML Document Title</title></head><body></body>\n\
+</html>\n"
+ (gnc:html-document-render test-doc)
+ )
)
+
+ (test-end "HTML Document - Creation")
)
;; -----------------------------------------------------------------------
-(define (test-check3)
- (let (
+(define (test-html-objects-definition-for-literals)
+
+ (test-begin "HTML Object Definitions for literals")
+
+ (test-equal "HTML Object for Strings"
+ (string-append html-doc-header-empty-title "<string> HTML Plain Text Body" html-doc-tail)
+ (let (
(test-doc (gnc:make-html-document))
- )
-
- (gnc:html-document-append-objects! test-doc
- (list
- (gnc:make-html-text
- "HTML Text Body - Part 1."
- "Part 2."
- )
- (gnc:make-html-text
- (gnc:html-markup/format
- "HTML Text with number ~a in decimal format."
- 7
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-object "HTML Plain Text Body")
+ )
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Object for Numbers"
+ (string-append html-doc-header-empty-title "<number> 1234567890" html-doc-tail)
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-object 1234567890)
+ )
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Object for Boolean TRUE"
+ (string-append html-doc-header-empty-title "<boolean> #t" html-doc-tail)
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-object #t)
+ )
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-expect-fail 1)
+ (test-equal "HTML Object for Boolean FALSE - Bug 796828"
+ (string-append html-doc-header-empty-title "<boolean> #f" html-doc-tail)
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-object #f)
+ )
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Object for generic types"
+ (string-append html-doc-header-empty-title "<generic> (a b c d)" html-doc-tail)
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-object '(a b c d))
+ )
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-end "HTML Object Definitions for literals")
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-html-objects)
+
+ (test-begin "HTML Text Objects")
+
+ (test-equal "HTML Text Object - no markup"
+ (string-append html-doc-header-empty-title
+ "<string> HTML Text Body - Part 1.<string> Part 2."
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ "HTML Text Body - Part 1."
+ "Part 2."
)
)
- (gnc:make-html-text
- (gnc:html-markup/format
- "HTML Text with number ~a in float format."
- 8.8
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - with number in decimal format"
+ (string-append html-doc-header-empty-title
+ "HTML Text with number <number> 7 in decimal format."
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with number ~a in decimal format."
+ 7
+ )
)
)
- (gnc:make-html-text
- (gnc:html-markup/format
- "HTML Text with boolean ~a." #f
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - with number in float format"
+ (string-append html-doc-header-empty-title
+ "HTML Text with number <number> 8.8 in float format."
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with number ~a in float format."
+ 8.8
+ )
)
)
- (gnc:make-html-text
- (gnc:html-markup/format
- "HTML Text with literal ~a."
- "text123"
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - with boolean format"
+ (string-append html-doc-header-empty-title
+ "HTML Text with boolean <boolean> #f."
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with boolean ~a."
+ #f
+ )
)
)
- (gnc:make-html-text
- (gnc:html-markup/format
- "HTML Text with generic ~a."
- '(a b c d)
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - with literal format"
+ (string-append html-doc-header-empty-title
+ "HTML Text with literal <string> text123."
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with literal ~a."
+ "text123"
+ )
)
)
- (gnc:make-html-text
- (gnc:html-markup-p "HTML Text Paragraph")
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - with generic format"
+ (string-append html-doc-header-empty-title
+ "HTML Text with generic <generic> (a b c d)."
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with generic ~a."
+ '(a b c d)
+ )
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-tt "HTML Text Typewriter")
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Paragraph"
+ (string-append html-doc-header-empty-title
+ "<p><string> HTML Text Paragraph</p>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-p "HTML Text Paragraph")
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-em "HTML Text Emphasized")
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Typewriter"
+ (string-append html-doc-header-empty-title
+ "<tt><string> HTML Text Typewriter</tt>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-tt "HTML Text Typewriter")
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-b "HTML Text Bold")
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Emphasized"
+ (string-append html-doc-header-empty-title
+ "<em><string> HTML Text Emphasized</em>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-em "HTML Text Emphasized")
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-i "HTML Text Italic")
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Bold"
+ (string-append html-doc-header-empty-title
+ "<b><string> HTML Text Bold</b>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-b "HTML Text Bold")
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-h1 "HTML Text Heading1")
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Italic"
+ (string-append html-doc-header-empty-title
+ "<i><string> HTML Text Italic</i>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-i "HTML Text Italic")
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-h2 "HTML Text Heading2")
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Heading1"
+ (string-append html-doc-header-empty-title
+ "<h1><string> HTML Text Heading1</h1>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-h1 "HTML Text Heading1")
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-h3 "HTML Text Heading3")
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Heading2"
+ (string-append html-doc-header-empty-title
+ "<h2><string> HTML Text Heading2</h2>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-h2 "HTML Text Heading2")
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-br)
- "HTML Text Linebreak"
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Heading3"
+ (string-append html-doc-header-empty-title
+ "<h3><string> HTML Text Heading3</h3>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-h3 "HTML Text Heading3")
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-hr)
- "HTML Text Headrow"
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Linebreak"
+ (string-append html-doc-header-empty-title
+ "<br /><string> HTML Text Linebreak"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-br)
+ "HTML Text Linebreak"
+ )
)
- (gnc:make-html-text
- "HTML Text Unsorted List"
- (gnc:html-markup-ul '("Item1" "Item2"))
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Headrow"
+ (string-append html-doc-header-empty-title
+ "<hr /><string> HTML Text Headrow"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-hr)
+ "HTML Text Headrow"
+ )
)
- (gnc:make-html-text
- (gnc:html-markup-anchor
- "HTML Text Anchor Link"
- "HTML Text Anchor Description"
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Unsorted List"
+ (string-append html-doc-header-empty-title
+ "<string> HTML Text Unsorted List<ul><li><string> Item1</li>\n<li><string> Item2</li>\n</ul>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ "HTML Text Unsorted List"
+ (gnc:html-markup-ul '("Item1" "Item2"))
)
)
- (gnc:make-html-text
- (gnc:html-markup-img
- "http://www.gnucash.org/images/banner5.png"
- '("width" "72")
- '("height" "48")
- '("alt" "GunCash web site")
+ )
+ (gnc:html-document-render test-doc)
+ )
+ )
+
+ (test-equal "HTML Text Object - Anchor Link"
+ (string-append html-doc-header-empty-title
+ "<a href=\"HTML Text Anchor Link\"><string> HTML Text Anchor Description</a>\n"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-anchor
+ "HTML Text Anchor Link"
+ "HTML Text Anchor Description"
+ )
)
)
)
+ (gnc:html-document-render test-doc)
)
+ )
- (string=?
+ (test-equal "HTML Text Object - Image"
+ (string-append html-doc-header-empty-title
+ "<img src=\"http://www.gnucash.org/images/banner5.png\" width=\"72\" height=\"48\" alt=\"GunCash web site\" />"
+ html-doc-tail
+ )
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-img
+ "http://www.gnucash.org/images/banner5.png"
+ '("width" "72")
+ '("height" "48")
+ '("alt" "GunCash web site")
+ )
+ )
+ )
+ )
(gnc:html-document-render test-doc)
-"<html>\n\
-<head>\n\
-<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
-<title>\n\
-</title></head><body><string> HTML Text Body - Part 1.\
-<string> Part 2.HTML Text with number <number> 7 in decimal format.\
-HTML Text with number <number> 8.8 in float format.\
-HTML Text with boolean <boolean> #f.\
-HTML Text with literal <string> text123.\
-HTML Text with generic <generic> (a b c d).\
-<p><string> HTML Text Paragraph</p>\n\
-<tt><string> HTML Text Typewriter</tt>\n\
-<em><string> HTML Text Emphasized</em>\n\
-<b><string> HTML Text Bold</b>\n\
-<i><string> HTML Text Italic</i>\n\
-<h1><string> HTML Text Heading1</h1>\n\
-<h2><string> HTML Text Heading2</h2>\n\
-<h3><string> HTML Text Heading3</h3>\n\
-<br /><string> HTML Text Linebreak\
-<hr /><string> HTML Text Headrow\
-<string> HTML Text Unsorted List<ul><li><string> Item1</li>\n\
-<li><string> Item2</li>\n\
-</ul>\n\
-<a href=\"HTML Text Anchor Link\"><string> HTML Text Anchor Description</a>\n\
-<img src=\"http://www.gnucash.org/images/banner5.png\" \
-width=\"72\" height=\"48\" alt=\"GunCash web site\" /></body>\n\
-</html>\n")
+ )
)
+
+ (test-end "HTML Text Objects")
)
;; -----------------------------------------------------------------------
-(define (test-check4)
- (let (
- (test-doc (gnc:make-html-document))
- (html-table-cell (gnc:make-html-table-cell "HTML Table Cell"))
- )
- (gnc:html-table-cell-set-rowspan! html-table-cell 2)
- (gnc:html-table-cell-set-colspan! html-table-cell 3)
- (gnc:html-table-cell-set-tag! html-table-cell "tag")
- (gnc:html-table-cell-append-objects!
- html-table-cell "obj1" "obj2" 123 #t #f '(a b c d)
- )
+(define (test-html-cells)
+
+ (test-begin "HTML Cells")
+
+ (test-expect-fail 1)
+ (test-equal "HTML Cell Creation - Bug 796828"
- (string=?
- (string-concatenate
- (gnc:html-document-tree-collapse
- (gnc:html-table-cell-render html-table-cell test-doc)))
"<tag rowspan=\"2\" colspan=\"3\">\
<string> HTML Table Cell\
<string> obj1\
<string> obj2<number> 123\
<boolean> #t\
-<string> <generic> (a b c d)</tag>\n")
- ;; BUG: it is not possible to create a boolean false object
- ;; instead a string place holder is created
+<boolean> #f\
+<generic> (a b c d)</tag>\n"
+
+ (let (
+ (test-doc (gnc:make-html-document))
+ (html-table-cell (gnc:make-html-table-cell "HTML Table Cell"))
+ )
+ (gnc:html-table-cell-set-rowspan! html-table-cell 2)
+ (gnc:html-table-cell-set-colspan! html-table-cell 3)
+ (gnc:html-table-cell-set-tag! html-table-cell "tag")
+ (gnc:html-table-cell-append-objects!
+ html-table-cell "obj1" "obj2" 123 #t #f '(a b c d)
+ )
+ (string-concatenate
+ (gnc:html-document-tree-collapse
+ (gnc:html-table-cell-render html-table-cell test-doc)
+ )
+ )
+ )
)
+
+ (test-end "HTML Cells")
)
;; -----------------------------------------------------------------------
-(define (test-check5)
- (let (
- (test-doc (gnc:make-html-document))
- (test-table (gnc:make-html-table))
- )
+(define (test-html-table)
+
+ ;; A table is list of rows in reverse order
+ ;; Each row is a list of cells
+ ;; The position the cell corresponds a column of the table
+ ;;
+ ;; Example:
+ ;; ((r2c0 r2c1 r2c2) (r1c0 r1c1) (r0c0))
+ ;;
+ ;; The cell in row 1 and col 1 is r1c1. Each cell should hold
+ ;; a html cell object (see previous test case).
+
+ (test-begin "HTML Tables - without style sheets")
- ;; A table is list of rows in reverse order
- ;; Each row is a list of cells
- ;; The position the cell corresponds a column of the table
- ;;
- ;; Example:
- ;; ((r2c0 r2c1 r2c2) (r1c0 r1c1) (r0c0))
- ;;
- ;; The cell in row 1 and col 1 is r1c1. Each cell should hold
- ;; a html cell object (see previous test case).
-
- ;; change the default settings just to see what effect it has
- ;;(gnc:html-table-set-col-headers! test-table #t)
- ;; -> this make (gnc:html-table-render test-table test-doc) crash
- ;; col-headers must be #f or a list
- (gnc:html-table-set-row-headers! test-table #t)
- (gnc:html-table-set-caption! test-table #t)
-
- (and
- (= (gnc:html-table-append-row! test-table "Row 1") 1)
- (= (gnc:html-table-append-row! test-table "Row 2") 2)
- ;; data is now: (("Row 2") ("Row 1"))
- (= (gnc:html-table-num-rows test-table) 2)
- (= (length (gnc:html-table-remove-last-row! test-table)) 1)
- (= (length (gnc:html-table-remove-last-row! test-table)) 0)
- ;; simple negative test: try to remove non existing row
- (null? (gnc:html-table-remove-last-row! test-table))
-
- (= (gnc:html-table-append-row! test-table "Row 2") 1)
- (= (gnc:html-table-prepend-row! test-table "Row 1") 2)
- (= (gnc:html-table-prepend-row! test-table "Row 0") 3)
- (= (gnc:html-table-prepend-row! test-table "Row -1") 4)
- ;; BUG: data is now: (("Row 2") "Row 1" "Row 0" "Row -1")
- ;; for (gnc:html-table-get-cell test-table 2 0)
- ;; this leads to error:
- ;; (wrong-type-arg "length"
- ;; "Wrong type argument in position ~A: ~S" (1 "Row 1") ("Row 1"))
-
- ;; BUG: gnc:html-table-prepend-row! updates
- ;; the row-markup hash table which is
- ;; - not updated on deletion of a row
- ;; - not updated anywhere else in the code
- ;; - not used anywhere else in GnuCash
- ;; --> should be removed
- ;; (same goes for gnc:html-table-row-markup,
- ;; gnc:html-table-set-row-markup-table! gnc:html-table-set-row-markup!)
-
- ;; Reset table data due to bug above:
- (gnc:html-table-set-data! test-table '())
-
- ;; luckily for testng, this is not internal - BUG?
- (gnc:html-table-set-num-rows-internal! test-table 0)
-
- (= (gnc:html-table-append-row! test-table "Row 1") 1)
- (= (gnc:html-table-append-row! test-table "Row 2") 2)
- (= (gnc:html-table-append-row! test-table "Row 3") 3)
- (string=? (gnc:html-table-get-cell test-table 2 0) "Row 3")
- (not (gnc:html-table-get-cell test-table 1 1)) ;; simple negative test
- (not (gnc:html-table-get-cell test-table -1 0)) ;; simple negative test
- (and
- (gnc:html-table-set-cell! test-table 2 1 "Row 3 Col 1")
- (string=?
- (car
- (gnc:html-table-cell-data
- (gnc:html-table-get-cell test-table 2 1)
+ (test-begin "Row Manipulations")
+ (test-begin "Append Rows")
+ (let (
+ (test-doc (gnc:make-html-document))
+ (test-table (gnc:make-html-table))
+ )
+ ;; change the default settings just to see what effect it has
+ ;;(gnc:html-table-set-col-headers! test-table #t)
+ ;; -> this make (gnc:html-table-render test-table test-doc) crash
+ ;; col-headers must be #f or a list
+ (gnc:html-table-set-row-headers! test-table #t)
+ (gnc:html-table-set-caption! test-table #t)
+ (gnc:html-table-append-row! test-table "Row 1")
+ (gnc:html-table-append-row! test-table "Row 2")
+ (test-equal "Check Num Rows after append row"
+ 2
+ (gnc:html-table-num-rows test-table)
+ )
+ (test-equal "Check data after append row"
+ '(("Row 2") ("Row 1"))
+ (gnc:html-table-data test-table)
+ )
+ )
+ (test-end "Append Rows")
+ (test-begin "Remove Rows")
+ (let (
+ (test-doc (gnc:make-html-document))
+ (test-table (gnc:make-html-table))
+ )
+ ;; change the default settings just to see what effect it has
+ ;;(gnc:html-table-set-col-headers! test-table #t)
+ ;; -> this make (gnc:html-table-render test-table test-doc) crash
+ ;; col-headers must be #f or a list
+ (gnc:html-table-set-row-headers! test-table #t)
+ (gnc:html-table-set-caption! test-table #t)
+ (gnc:html-table-append-row! test-table "Row 1")
+ (gnc:html-table-append-row! test-table "Row 2")
+ (gnc:html-table-remove-last-row! test-table)
+ (test-equal "Check Num Rows after remove row"
+ 1
+ (gnc:html-table-num-rows test-table)
+ )
+ (test-equal "Check data after remove row"
+ '(("Row 1"))
+ (gnc:html-table-data test-table)
+ )
+ (gnc:html-table-remove-last-row! test-table)
+ (test-equal "Negative Test: Remove non-existing rows" '() (gnc:html-table-remove-last-row! test-table))
+ )
+ (test-end "Remove Rows")
+ (test-begin "Prepend Rows")
+ (let (
+ (test-doc (gnc:make-html-document))
+ (test-table (gnc:make-html-table))
+ )
+ ;; change the default settings just to see what effect it has
+ ;;(gnc:html-table-set-col-headers! test-table #t)
+ ;; -> this make (gnc:html-table-render test-table test-doc) crash
+ ;; col-headers must be #f or a list
+ (gnc:html-table-set-row-headers! test-table #t)
+ (gnc:html-table-set-caption! test-table #t)
+ (gnc:html-table-append-row! test-table "Row 2")
+ (gnc:html-table-prepend-row! test-table "Row 1")
+ (gnc:html-table-prepend-row! test-table "Row 0")
+ (gnc:html-table-prepend-row! test-table "Row -1")
+ (test-equal "Check Num Rows after prepend row"
+ 4
+ (gnc:html-table-num-rows test-table)
+ )
+ (test-expect-fail 1)
+ (test-equal "Check data after prepend row - Bug 796829"
+ '(("Row 2") ("Row 1") ("Row 0") ("Row -1"))
+ (gnc:html-table-data test-table)
+ )
+ )
+ (test-end "Prepend Rows")
+ (test-end "Row Manipulations")
+ (test-begin "Cell Access and Edit")
+ (let (
+ (test-doc (gnc:make-html-document))
+ (test-table (gnc:make-html-table))
+ )
+ ;; change the default settings just to see what effect it has
+ ;;(gnc:html-table-set-col-headers! test-table #t)
+ ;; -> this make (gnc:html-table-render test-table test-doc) crash
+ ;; col-headers must be #f or a list
+ (gnc:html-table-set-row-headers! test-table #t)
+ (gnc:html-table-set-caption! test-table #t)
+ (gnc:html-table-append-row! test-table "Row 1")
+ (gnc:html-table-append-row! test-table "Row 2")
+ (gnc:html-table-append-row! test-table "Row 3")
+ (test-equal "Check Cell Access"
+ "Row 1Row 2Row 3"
+ (string-append
+ (gnc:html-table-get-cell test-table 0 0)
+ (gnc:html-table-get-cell test-table 1 0)
+ (gnc:html-table-get-cell test-table 2 0)
+ )
+ )
+ (test-assert "Negative Test: Check Cell Access - non-existing cells"
+ (not
+ (or (gnc:html-table-get-cell test-table 1 1)
+ (gnc:html-table-get-cell test-table -1 0)
)
)
- "Row 3 Col 1")
+ )
)
- (and
- (gnc:html-table-remove-last-row! test-table) ;; -> (("Row 2") ("Row 1"))
-
- (not
- (gnc:html-table-append-column!
- test-table
- '("Col A" "Col B" "Col C")
- )
- ) ;; -> (("Col C") ("Row 2" "Col B") ("Row 1" "Col A"))
-
- (string=? (gnc:html-table-get-cell test-table 0 0) "Row 1")
- (string=? (gnc:html-table-get-cell test-table 1 0) "Row 2")
- ;;(string=? (gnc:html-table-get-cell test-table 2 0) "Col C")
- ;; -> error: "Value out of range"
- ;; Bug: the row counter has not been adjusted, should be three
+ (test-end "Cell Access and Edit")
+ (test-begin "Append Columns")
+ (let (
+ (test-doc (gnc:make-html-document))
+ (test-table (gnc:make-html-table))
+ )
+ ;; change the default settings just to see what effect it has
+ ;;(gnc:html-table-set-col-headers! test-table #t)
+ ;; -> this make (gnc:html-table-render test-table test-doc) crash
+ ;; col-headers must be #f or a list
+ (gnc:html-table-set-row-headers! test-table #t)
+ (gnc:html-table-set-caption! test-table #t)
+ (gnc:html-table-append-row! test-table "Row 1")
+ (gnc:html-table-append-row! test-table "Row 2")
+ (gnc:html-table-append-column! test-table '("Col A" "Col B" "Col C"))
+ (test-equal "Check Num Rows after append column"
+ 3
+ (gnc:html-table-num-rows test-table)
+ )
+ (test-expect-fail 2)
+ (test-equal "Check data after append column - Bug"
+ '((" " "Col C") ("Row 2" "Col B") ("Row 1" "Col A"))
+ (gnc:html-table-data test-table)
+ )
+ (test-equal "Check Cell Access after append column - Bug 796831"
+ "Col C"
+ (gnc:html-table-get-cell test-table 2 1)
+ )
)
- (string=?
- (string-concatenate
- (gnc:html-document-tree-collapse
- (gnc:html-table-render test-table test-doc)))
+ (test-end "Append Columns")
+ (test-begin "Table Rendering")
+ (let (
+ (test-doc (gnc:make-html-document))
+ (test-table (gnc:make-html-table))
+ )
+ ;; change the default settings just to see what effect it has
+ ;;(gnc:html-table-set-col-headers! test-table #t)
+ ;; -> this make (gnc:html-table-render test-table test-doc) crash
+ ;; col-headers must be #f or a list
+ (gnc:html-table-set-row-headers! test-table #t)
+ (gnc:html-table-set-caption! test-table #t)
+ (gnc:html-table-append-row! test-table "Row 1")
+ (gnc:html-table-append-row! test-table "Row 2")
+ (gnc:html-table-append-column! test-table '("Col A" "Col B"))
+ (test-equal "Check table rendering result"
"<table><caption><boolean> #t</caption>\n\
-<tbody><tr><td><string> Row 1</td>\n\
-<td><string> Col A</td>\n\
-</tr>\n\
-<tr><td><string> Row 2</td>\n\
-<td><string> Col B</td>\n\
-</tr>\n\
-<tr><td><string> Col C</td>\n\
-</tr>\n\
+<tbody>\
+<tr><td><string> Row 1</td>\n<td><string> Col A</td>\n</tr>\n\
+<tr><td><string> Row 2</td>\n<td><string> Col B</td>\n</tr>\n\
</tbody>\n\
-</table>\n")
- )
- )
+</table>\n"
+ (string-concatenate
+ (gnc:html-document-tree-collapse
+ (gnc:html-table-render test-table test-doc)
+ )
+ )
+ )
+ )
+ (test-end "Table Rendering")
+
+ (test-end "HTML Tables - without style sheets")
)
commit b0c5381cee6f20b9683eb272cb1d6a95cab5bdb0
Author: Carsten Rinke <carsten.rinke at gmx.de>
Date: Thu Aug 9 19:15:29 2018 +0200
test-report-html.scm reformatted (cosmetic)
diff --git a/gnucash/report/report-system/test/test-report-html.scm b/gnucash/report/report-system/test/test-report-html.scm
index 32cc827..11a265a 100644
--- a/gnucash/report/report-system/test/test-report-html.scm
+++ b/gnucash/report/report-system/test/test-report-html.scm
@@ -9,8 +9,9 @@
(define (run-test)
(test-runner-factory gnc:test-runner)
- (test-begin "Testing/Temporary/test-report-html") ;; if (test-runner-factory gnc:test-runner) is commented out, this
- ;; will create Testing/Temporary/test-report-html.log
+ (test-begin "Testing/Temporary/test-report-html")
+ ;; if (test-runner-factory gnc:test-runner) is commented out, this
+ ;; will create Testing/Temporary/test-report-html.log
(test-assert "HTML Document Definition" (test-check1))
(test-assert "HTML Objects Definition for literals" (test-check2))
(test-assert "HTML Text Object" (test-check3))
@@ -34,37 +35,48 @@
(string-null? (gnc:html-document-title test-doc))
(not (gnc:html-document-headline test-doc))
(null? (gnc:html-document-objects test-doc))
- (string=? (gnc:html-document-render test-doc)
- "<html>\n<head>\n<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n<title>\n</title></head><body></body>\n</html>\n"
- ;; BUG?:
- ;; this code looks ugly
- ;;<html>
- ;;<head>
- ;;<meta http-equiv="content-type" content="text/html; charset=utf-8" />
- ;;<title>
- ;;</title></head><body></body>
- ;;</html>
-
- ;; BUG?:
- ;; There is no way to suppress the header, (not (null? headers?)) is always true
-
- ;; BUG?:
- ;; There is no way to suppress the title, (if (title)) is always true
- ;; BUG?:
- ;; title is already defined, no reason to make a (let) statement
- ;; so this
- ;; (let ((title (gnc:html-document-title doc)))
- ;; (if title
- ;; (push (list "</title>" title "<title>\n"))))
- ;; should be this
- ;; (if (not (string-null? title))
- ;; (push (list "</title>" title "<title>\n")))
+ (string=?
+ (gnc:html-document-render test-doc)
+"<html>\n\
+<head>\n\
+<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
+<title>\n\
+</title></head><body></body>\n\
+</html>\n")
+ ;; BUG?:
+ ;; this code looks ugly
+ ;;<html>
+ ;;<head>
+ ;;<meta http-equiv="content-type" content="text/html; charset=utf-8" />
+ ;;<title>
+ ;;</title></head><body></body>
+ ;;</html>
+
+ ;; BUG?:
+ ;; There is no way to suppress the header,
+ ;; (not (null? headers?)) is always true
+
+ ;; BUG?:
+ ;; There is no way to suppress the title, (if (title)) is always true
+ ;; BUG?:
+ ;; title is already defined, no reason to make a (let) statement
+ ;; so this
+ ;; (let ((title (gnc:html-document-title doc)))
+ ;; (if title
+ ;; (push (list "</title>" title "<title>\n"))))
+ ;; should be this
+ ;; (if (not (string-null? title))
+ ;; (push (list "</title>" title "<title>\n")))
- )
(gnc:html-document-set-title! test-doc "HTML Document Title")
- (string=? (gnc:html-document-render test-doc)
- "<html>\n<head>\n<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n<title>\nHTML Document Title</title></head><body></body>\n</html>\n"
- )
+ (string=?
+ (gnc:html-document-render test-doc)
+"<html>\n\
+<head>\n\
+<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
+<title>\n\
+HTML Document Title</title></head><body></body>\n\
+</html>\n")
)
)
)
@@ -86,8 +98,17 @@
)
)
- (string=? (gnc:html-document-render test-doc) "<html>\n<head>\n<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n<title>\n</title></head><body><string> HTML Plain Text Body<number> 1234567890<boolean> #t<string> <generic> (a b c d)</body>\n</html>\n")
- ;; BUG: it is not possible to create a boolean false object, instead a string place holder is created
+ (string=?
+ (gnc:html-document-render test-doc)
+"<html>\n\
+<head>\n\
+<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
+<title>\n\
+</title></head><body><string> HTML Plain Text Body<number> 1234567890\
+<boolean> #t<string> <generic> (a b c d)</body>\n\
+</html>\n")
+ ;; BUG: it is not possible to create a boolean false object
+ ;; instead a string place holder is created
)
)
@@ -100,30 +121,121 @@
(gnc:html-document-append-objects! test-doc
(list
- (gnc:make-html-text "HTML Text Body - Part 1." "Part 2.")
- (gnc:make-html-text (gnc:html-markup/format "HTML Text with number ~a in decimal format." 7))
- (gnc:make-html-text (gnc:html-markup/format "HTML Text with number ~a in float format." 8.8))
- (gnc:make-html-text (gnc:html-markup/format "HTML Text with boolean ~a." #f))
- (gnc:make-html-text (gnc:html-markup/format "HTML Text with literal ~a." "text123"))
- (gnc:make-html-text (gnc:html-markup/format "HTML Text with generic ~a." '(a b c d)))
- (gnc:make-html-text (gnc:html-markup-p "HTML Text Paragraph"))
- (gnc:make-html-text (gnc:html-markup-tt "HTML Text Typewriter"))
- (gnc:make-html-text (gnc:html-markup-em "HTML Text Emphasized"))
- (gnc:make-html-text (gnc:html-markup-b "HTML Text Bold"))
- (gnc:make-html-text (gnc:html-markup-i "HTML Text Italic"))
- (gnc:make-html-text (gnc:html-markup-h1 "HTML Text Heading1"))
- (gnc:make-html-text (gnc:html-markup-h2 "HTML Text Heading2"))
- (gnc:make-html-text (gnc:html-markup-h3 "HTML Text Heading3"))
- (gnc:make-html-text (gnc:html-markup-br) "HTML Text Linebreak")
- (gnc:make-html-text (gnc:html-markup-hr) "HTML Text Headrow")
- (gnc:make-html-text "HTML Text Unsorted List" (gnc:html-markup-ul '("Item1" "Item2")))
- (gnc:make-html-text (gnc:html-markup-anchor "HTML Text Anchor Link" "HTML Text Anchor Description"))
- (gnc:make-html-text (gnc:html-markup-img "http://www.gnucash.org/images/banner5.png" '("width" "72") '("height" "48") '("alt" "GunCash web site")))
+ (gnc:make-html-text
+ "HTML Text Body - Part 1."
+ "Part 2."
+ )
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with number ~a in decimal format."
+ 7
+ )
+ )
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with number ~a in float format."
+ 8.8
+ )
+ )
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with boolean ~a." #f
+ )
+ )
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with literal ~a."
+ "text123"
+ )
+ )
+ (gnc:make-html-text
+ (gnc:html-markup/format
+ "HTML Text with generic ~a."
+ '(a b c d)
+ )
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-p "HTML Text Paragraph")
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-tt "HTML Text Typewriter")
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-em "HTML Text Emphasized")
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-b "HTML Text Bold")
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-i "HTML Text Italic")
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-h1 "HTML Text Heading1")
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-h2 "HTML Text Heading2")
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-h3 "HTML Text Heading3")
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-br)
+ "HTML Text Linebreak"
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-hr)
+ "HTML Text Headrow"
+ )
+ (gnc:make-html-text
+ "HTML Text Unsorted List"
+ (gnc:html-markup-ul '("Item1" "Item2"))
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-anchor
+ "HTML Text Anchor Link"
+ "HTML Text Anchor Description"
+ )
+ )
+ (gnc:make-html-text
+ (gnc:html-markup-img
+ "http://www.gnucash.org/images/banner5.png"
+ '("width" "72")
+ '("height" "48")
+ '("alt" "GunCash web site")
+ )
+ )
)
)
- (string=? (gnc:html-document-render test-doc) "<html>\n<head>\n<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n<title>\n</title></head><body><string> HTML Text Body - Part 1.<string> Part 2.HTML Text with number <number> 7 in decimal format.HTML Text with number <number> 8.8 in float format.HTML Text with boolean <boolean> #f.HTML Text with literal <string> text123.HTML Text with generic <generic> (a b c d).<p><string> HTML Text Paragraph</p>\n<tt><string> HTML Text Typewriter</tt>\n<em><string> HTML Text Emphasized</em>\n<b><string> HTML Text Bold</b>\n<i><string> HTML Text Italic</i>\n<h1><string> HTML Text Heading1</h1>\n<h2><string> HTML Text Heading2</h2>\n<h3><string> HTML Text Heading3</h3>\n<br /><string> HTML Text Linebreak<hr /><string> HTML Text Headrow<string> HTML Text Unsorted List<ul><li><string> Item1</li>\n<li><string> Item2</li>\n</ul>\n<a href=\"HTML Text Anchor Link\"><string> HTML Text Anchor Description</a>\n<img src=\"http://www.gnucash.org/images/banner5.png\" width=\"72\" height=\"48\" alt=\"GunCash web site\" /></body>\n</html>\n")
-
+ (string=?
+ (gnc:html-document-render test-doc)
+"<html>\n\
+<head>\n\
+<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
+<title>\n\
+</title></head><body><string> HTML Text Body - Part 1.\
+<string> Part 2.HTML Text with number <number> 7 in decimal format.\
+HTML Text with number <number> 8.8 in float format.\
+HTML Text with boolean <boolean> #f.\
+HTML Text with literal <string> text123.\
+HTML Text with generic <generic> (a b c d).\
+<p><string> HTML Text Paragraph</p>\n\
+<tt><string> HTML Text Typewriter</tt>\n\
+<em><string> HTML Text Emphasized</em>\n\
+<b><string> HTML Text Bold</b>\n\
+<i><string> HTML Text Italic</i>\n\
+<h1><string> HTML Text Heading1</h1>\n\
+<h2><string> HTML Text Heading2</h2>\n\
+<h3><string> HTML Text Heading3</h3>\n\
+<br /><string> HTML Text Linebreak\
+<hr /><string> HTML Text Headrow\
+<string> HTML Text Unsorted List<ul><li><string> Item1</li>\n\
+<li><string> Item2</li>\n\
+</ul>\n\
+<a href=\"HTML Text Anchor Link\"><string> HTML Text Anchor Description</a>\n\
+<img src=\"http://www.gnucash.org/images/banner5.png\" \
+width=\"72\" height=\"48\" alt=\"GunCash web site\" /></body>\n\
+</html>\n")
)
)
@@ -137,11 +249,22 @@
(gnc:html-table-cell-set-rowspan! html-table-cell 2)
(gnc:html-table-cell-set-colspan! html-table-cell 3)
(gnc:html-table-cell-set-tag! html-table-cell "tag")
- (gnc:html-table-cell-append-objects! html-table-cell "obj1" "obj2" 123 #t #f '(a b c d))
+ (gnc:html-table-cell-append-objects!
+ html-table-cell "obj1" "obj2" 123 #t #f '(a b c d)
+ )
- (string=? (string-concatenate (gnc:html-document-tree-collapse (gnc:html-table-cell-render html-table-cell test-doc)))
- "<tag rowspan=\"2\" colspan=\"3\"><string> HTML Table Cell<string> obj1<string> obj2<number> 123<boolean> #t<string> <generic> (a b c d)</tag>\n"
- ) ;; BUG: it is not possible to create a boolean false object, instead a string place holder is created
+ (string=?
+ (string-concatenate
+ (gnc:html-document-tree-collapse
+ (gnc:html-table-cell-render html-table-cell test-doc)))
+"<tag rowspan=\"2\" colspan=\"3\">\
+<string> HTML Table Cell\
+<string> obj1\
+<string> obj2<number> 123\
+<boolean> #t\
+<string> <generic> (a b c d)</tag>\n")
+ ;; BUG: it is not possible to create a boolean false object
+ ;; instead a string place holder is created
)
)
@@ -165,33 +288,46 @@
;; change the default settings just to see what effect it has
;;(gnc:html-table-set-col-headers! test-table #t)
- ;; -> this make (gnc:html-table-render test-table test-doc) crash, col-headers must be #f or a list
+ ;; -> this make (gnc:html-table-render test-table test-doc) crash
+ ;; col-headers must be #f or a list
(gnc:html-table-set-row-headers! test-table #t)
(gnc:html-table-set-caption! test-table #t)
(and
(= (gnc:html-table-append-row! test-table "Row 1") 1)
- (= (gnc:html-table-append-row! test-table "Row 2") 2) ;; data is now: (("Row 2") ("Row 1"))
+ (= (gnc:html-table-append-row! test-table "Row 2") 2)
+ ;; data is now: (("Row 2") ("Row 1"))
(= (gnc:html-table-num-rows test-table) 2)
(= (length (gnc:html-table-remove-last-row! test-table)) 1)
(= (length (gnc:html-table-remove-last-row! test-table)) 0)
- (null? (gnc:html-table-remove-last-row! test-table)) ;; simple negative test: try to remove non existing row
+ ;; simple negative test: try to remove non existing row
+ (null? (gnc:html-table-remove-last-row! test-table))
+
(= (gnc:html-table-append-row! test-table "Row 2") 1)
(= (gnc:html-table-prepend-row! test-table "Row 1") 2)
(= (gnc:html-table-prepend-row! test-table "Row 0") 3)
(= (gnc:html-table-prepend-row! test-table "Row -1") 4)
;; BUG: data is now: (("Row 2") "Row 1" "Row 0" "Row -1")
;; for (gnc:html-table-get-cell test-table 2 0)
- ;; this leads to error: (wrong-type-arg "length" "Wrong type argument in position ~A: ~S" (1 "Row 1") ("Row 1"))
- ;; BUG: gnc:html-table-prepend-row! updates the row-markup hash table which is
+ ;; this leads to error:
+ ;; (wrong-type-arg "length"
+ ;; "Wrong type argument in position ~A: ~S" (1 "Row 1") ("Row 1"))
+
+ ;; BUG: gnc:html-table-prepend-row! updates
+ ;; the row-markup hash table which is
;; - not updated on deletion of a row
;; - not updated anywhere else in the code
;; - not used anywhere else in GnuCash
;; --> should be removed
- ;; (same goes for gnc:html-table-row-markup, gnc:html-table-set-row-markup-table! gnc:html-table-set-row-markup!)
- ;; Reset table data:
- (gnc:html-table-set-data! test-table '()) ;; reset the table data due to bug above
- (gnc:html-table-set-num-rows-internal! test-table 0) ;; luckily for testng, this is not internal - BUG?
+ ;; (same goes for gnc:html-table-row-markup,
+ ;; gnc:html-table-set-row-markup-table! gnc:html-table-set-row-markup!)
+
+ ;; Reset table data due to bug above:
+ (gnc:html-table-set-data! test-table '())
+
+ ;; luckily for testng, this is not internal - BUG?
+ (gnc:html-table-set-num-rows-internal! test-table 0)
+
(= (gnc:html-table-append-row! test-table "Row 1") 1)
(= (gnc:html-table-append-row! test-table "Row 2") 2)
(= (gnc:html-table-append-row! test-table "Row 3") 3)
@@ -200,18 +336,45 @@
(not (gnc:html-table-get-cell test-table -1 0)) ;; simple negative test
(and
(gnc:html-table-set-cell! test-table 2 1 "Row 3 Col 1")
- (string=? (car (gnc:html-table-cell-data (gnc:html-table-get-cell test-table 2 1))) "Row 3 Col 1")
+ (string=?
+ (car
+ (gnc:html-table-cell-data
+ (gnc:html-table-get-cell test-table 2 1)
+ )
+ )
+ "Row 3 Col 1")
)
(and
(gnc:html-table-remove-last-row! test-table) ;; -> (("Row 2") ("Row 1"))
- (not (gnc:html-table-append-column! test-table '("Col A" "Col B" "Col C"))) ;; -> (("Col C") ("Row 2" "Col B") ("Row 1" "Col A"))
+
+ (not
+ (gnc:html-table-append-column!
+ test-table
+ '("Col A" "Col B" "Col C")
+ )
+ ) ;; -> (("Col C") ("Row 2" "Col B") ("Row 1" "Col A"))
+
(string=? (gnc:html-table-get-cell test-table 0 0) "Row 1")
(string=? (gnc:html-table-get-cell test-table 1 0) "Row 2")
- ;;(string=? (gnc:html-table-get-cell test-table 2 0) "Col C") ;; -> error: "Value out of range"
+ ;;(string=? (gnc:html-table-get-cell test-table 2 0) "Col C")
+ ;; -> error: "Value out of range"
;; Bug: the row counter has not been adjusted, should be three
)
- (string=? (string-concatenate (gnc:html-document-tree-collapse (gnc:html-table-render test-table test-doc)))
- "<table><caption><boolean> #t</caption>\n<tbody><tr><td><string> Row 1</td>\n<td><string> Col A</td>\n</tr>\n<tr><td><string> Row 2</td>\n<td><string> Col B</td>\n</tr>\n<tr><td><string> Col C</td>\n</tr>\n</tbody>\n</table>\n")
+ (string=?
+ (string-concatenate
+ (gnc:html-document-tree-collapse
+ (gnc:html-table-render test-table test-doc)))
+"<table><caption><boolean> #t</caption>\n\
+<tbody><tr><td><string> Row 1</td>\n\
+<td><string> Col A</td>\n\
+</tr>\n\
+<tr><td><string> Row 2</td>\n\
+<td><string> Col B</td>\n\
+</tr>\n\
+<tr><td><string> Col C</td>\n\
+</tr>\n\
+</tbody>\n\
+</table>\n")
)
)
)
commit c59157763f820b9eca42207a91650028fef2383d
Author: Carsten Rinke <carsten.rinke at gmx.de>
Date: Mon Jul 30 17:39:44 2018 +0200
Bug787401 - Test for the report system - HTML Tests
diff --git a/gnucash/report/report-system/test/CMakeLists.txt b/gnucash/report/report-system/test/CMakeLists.txt
index 5b43386..6aba16a 100644
--- a/gnucash/report/report-system/test/CMakeLists.txt
+++ b/gnucash/report/report-system/test/CMakeLists.txt
@@ -18,6 +18,7 @@ set (scm_test_report_system_with_srfi64_SOURCES
test-commodity-utils.scm
test-report-utilities.scm
test-html-utilities-srfi64.scm
+ test-report-html.scm
test-report-system.scm
)
diff --git a/gnucash/report/report-system/test/test-report-html.scm b/gnucash/report/report-system/test/test-report-html.scm
new file mode 100644
index 0000000..32cc827
--- /dev/null
+++ b/gnucash/report/report-system/test/test-report-html.scm
@@ -0,0 +1,217 @@
+(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 report-system))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+
+(define (run-test)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "Testing/Temporary/test-report-html") ;; if (test-runner-factory gnc:test-runner) is commented out, this
+ ;; will create Testing/Temporary/test-report-html.log
+ (test-assert "HTML Document Definition" (test-check1))
+ (test-assert "HTML Objects Definition for literals" (test-check2))
+ (test-assert "HTML Text Object" (test-check3))
+ (test-assert "HTML Table Cell" (test-check4))
+ (test-assert "HTML Table" (test-check5))
+ (test-end "Testing/Temporary/test-report-html")
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-check1)
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+ (and
+ (gnc:html-document? test-doc)
+ (not (gnc:html-document-style-sheet test-doc))
+ (null? (gnc:html-document-style-stack test-doc))
+ (gnc:html-style-table? (gnc:html-document-style test-doc))
+ (not (gnc:html-document-style-text test-doc))
+ (string-null? (gnc:html-document-title test-doc))
+ (not (gnc:html-document-headline test-doc))
+ (null? (gnc:html-document-objects test-doc))
+ (string=? (gnc:html-document-render test-doc)
+ "<html>\n<head>\n<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n<title>\n</title></head><body></body>\n</html>\n"
+ ;; BUG?:
+ ;; this code looks ugly
+ ;;<html>
+ ;;<head>
+ ;;<meta http-equiv="content-type" content="text/html; charset=utf-8" />
+ ;;<title>
+ ;;</title></head><body></body>
+ ;;</html>
+
+ ;; BUG?:
+ ;; There is no way to suppress the header, (not (null? headers?)) is always true
+
+ ;; BUG?:
+ ;; There is no way to suppress the title, (if (title)) is always true
+ ;; BUG?:
+ ;; title is already defined, no reason to make a (let) statement
+ ;; so this
+ ;; (let ((title (gnc:html-document-title doc)))
+ ;; (if title
+ ;; (push (list "</title>" title "<title>\n"))))
+ ;; should be this
+ ;; (if (not (string-null? title))
+ ;; (push (list "</title>" title "<title>\n")))
+
+ )
+ (gnc:html-document-set-title! test-doc "HTML Document Title")
+ (string=? (gnc:html-document-render test-doc)
+ "<html>\n<head>\n<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n<title>\nHTML Document Title</title></head><body></body>\n</html>\n"
+ )
+ )
+ )
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-check2)
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-object "HTML Plain Text Body")
+ (gnc:make-html-object 1234567890)
+ (gnc:make-html-object #t)
+ (gnc:make-html-object #f)
+ (gnc:make-html-object '(a b c d))
+ )
+ )
+
+ (string=? (gnc:html-document-render test-doc) "<html>\n<head>\n<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n<title>\n</title></head><body><string> HTML Plain Text Body<number> 1234567890<boolean> #t<string> <generic> (a b c d)</body>\n</html>\n")
+ ;; BUG: it is not possible to create a boolean false object, instead a string place holder is created
+ )
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-check3)
+ (let (
+ (test-doc (gnc:make-html-document))
+ )
+
+ (gnc:html-document-append-objects! test-doc
+ (list
+ (gnc:make-html-text "HTML Text Body - Part 1." "Part 2.")
+ (gnc:make-html-text (gnc:html-markup/format "HTML Text with number ~a in decimal format." 7))
+ (gnc:make-html-text (gnc:html-markup/format "HTML Text with number ~a in float format." 8.8))
+ (gnc:make-html-text (gnc:html-markup/format "HTML Text with boolean ~a." #f))
+ (gnc:make-html-text (gnc:html-markup/format "HTML Text with literal ~a." "text123"))
+ (gnc:make-html-text (gnc:html-markup/format "HTML Text with generic ~a." '(a b c d)))
+ (gnc:make-html-text (gnc:html-markup-p "HTML Text Paragraph"))
+ (gnc:make-html-text (gnc:html-markup-tt "HTML Text Typewriter"))
+ (gnc:make-html-text (gnc:html-markup-em "HTML Text Emphasized"))
+ (gnc:make-html-text (gnc:html-markup-b "HTML Text Bold"))
+ (gnc:make-html-text (gnc:html-markup-i "HTML Text Italic"))
+ (gnc:make-html-text (gnc:html-markup-h1 "HTML Text Heading1"))
+ (gnc:make-html-text (gnc:html-markup-h2 "HTML Text Heading2"))
+ (gnc:make-html-text (gnc:html-markup-h3 "HTML Text Heading3"))
+ (gnc:make-html-text (gnc:html-markup-br) "HTML Text Linebreak")
+ (gnc:make-html-text (gnc:html-markup-hr) "HTML Text Headrow")
+ (gnc:make-html-text "HTML Text Unsorted List" (gnc:html-markup-ul '("Item1" "Item2")))
+ (gnc:make-html-text (gnc:html-markup-anchor "HTML Text Anchor Link" "HTML Text Anchor Description"))
+ (gnc:make-html-text (gnc:html-markup-img "http://www.gnucash.org/images/banner5.png" '("width" "72") '("height" "48") '("alt" "GunCash web site")))
+ )
+ )
+
+ (string=? (gnc:html-document-render test-doc) "<html>\n<head>\n<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n<title>\n</title></head><body><string> HTML Text Body - Part 1.<string> Part 2.HTML Text with number <number> 7 in decimal format.HTML Text with number <number> 8.8 in float format.HTML Text with boolean <boolean> #f.HTML Text with literal <string> text123.HTML Text with generic <generic> (a b c d).<p><string> HTML Text Paragraph</p>\n<tt><string> HTML Text Typewriter</tt>\n<em><string> HTML Text Emphasized</em>\n<b><string> HTML Text Bold</b>\n<i><string> HTML Text Italic</i>\n<h1><string> HTML Text Heading1</h1>\n<h2><string> HTML Text Heading2</h2>\n<h3><string> HTML Text Heading3</h3>\n<br /><string> HTML Text Linebreak<hr /><string> HTML Text Headrow<string> HTML Text Unsorted List<ul><li><string> Item1</li>\n<li><string> Item2</li>\n</ul>\n<a href=\"HTML Text Anchor Link\"><string> HTML Text Anchor Description</a>\n<img src=\"http://www.gnucash.org/images/banner5.png\" width=\"72\" height=\"48\" alt=\"GunCash web site\" /></body>\n</html>\n")
+
+ )
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-check4)
+ (let (
+ (test-doc (gnc:make-html-document))
+ (html-table-cell (gnc:make-html-table-cell "HTML Table Cell"))
+ )
+ (gnc:html-table-cell-set-rowspan! html-table-cell 2)
+ (gnc:html-table-cell-set-colspan! html-table-cell 3)
+ (gnc:html-table-cell-set-tag! html-table-cell "tag")
+ (gnc:html-table-cell-append-objects! html-table-cell "obj1" "obj2" 123 #t #f '(a b c d))
+
+ (string=? (string-concatenate (gnc:html-document-tree-collapse (gnc:html-table-cell-render html-table-cell test-doc)))
+ "<tag rowspan=\"2\" colspan=\"3\"><string> HTML Table Cell<string> obj1<string> obj2<number> 123<boolean> #t<string> <generic> (a b c d)</tag>\n"
+ ) ;; BUG: it is not possible to create a boolean false object, instead a string place holder is created
+ )
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-check5)
+ (let (
+ (test-doc (gnc:make-html-document))
+ (test-table (gnc:make-html-table))
+ )
+
+ ;; A table is list of rows in reverse order
+ ;; Each row is a list of cells
+ ;; The position the cell corresponds a column of the table
+ ;;
+ ;; Example:
+ ;; ((r2c0 r2c1 r2c2) (r1c0 r1c1) (r0c0))
+ ;;
+ ;; The cell in row 1 and col 1 is r1c1. Each cell should hold
+ ;; a html cell object (see previous test case).
+
+ ;; change the default settings just to see what effect it has
+ ;;(gnc:html-table-set-col-headers! test-table #t)
+ ;; -> this make (gnc:html-table-render test-table test-doc) crash, col-headers must be #f or a list
+ (gnc:html-table-set-row-headers! test-table #t)
+ (gnc:html-table-set-caption! test-table #t)
+
+ (and
+ (= (gnc:html-table-append-row! test-table "Row 1") 1)
+ (= (gnc:html-table-append-row! test-table "Row 2") 2) ;; data is now: (("Row 2") ("Row 1"))
+ (= (gnc:html-table-num-rows test-table) 2)
+ (= (length (gnc:html-table-remove-last-row! test-table)) 1)
+ (= (length (gnc:html-table-remove-last-row! test-table)) 0)
+ (null? (gnc:html-table-remove-last-row! test-table)) ;; simple negative test: try to remove non existing row
+ (= (gnc:html-table-append-row! test-table "Row 2") 1)
+ (= (gnc:html-table-prepend-row! test-table "Row 1") 2)
+ (= (gnc:html-table-prepend-row! test-table "Row 0") 3)
+ (= (gnc:html-table-prepend-row! test-table "Row -1") 4)
+ ;; BUG: data is now: (("Row 2") "Row 1" "Row 0" "Row -1")
+ ;; for (gnc:html-table-get-cell test-table 2 0)
+ ;; this leads to error: (wrong-type-arg "length" "Wrong type argument in position ~A: ~S" (1 "Row 1") ("Row 1"))
+ ;; BUG: gnc:html-table-prepend-row! updates the row-markup hash table which is
+ ;; - not updated on deletion of a row
+ ;; - not updated anywhere else in the code
+ ;; - not used anywhere else in GnuCash
+ ;; --> should be removed
+ ;; (same goes for gnc:html-table-row-markup, gnc:html-table-set-row-markup-table! gnc:html-table-set-row-markup!)
+ ;; Reset table data:
+ (gnc:html-table-set-data! test-table '()) ;; reset the table data due to bug above
+ (gnc:html-table-set-num-rows-internal! test-table 0) ;; luckily for testng, this is not internal - BUG?
+ (= (gnc:html-table-append-row! test-table "Row 1") 1)
+ (= (gnc:html-table-append-row! test-table "Row 2") 2)
+ (= (gnc:html-table-append-row! test-table "Row 3") 3)
+ (string=? (gnc:html-table-get-cell test-table 2 0) "Row 3")
+ (not (gnc:html-table-get-cell test-table 1 1)) ;; simple negative test
+ (not (gnc:html-table-get-cell test-table -1 0)) ;; simple negative test
+ (and
+ (gnc:html-table-set-cell! test-table 2 1 "Row 3 Col 1")
+ (string=? (car (gnc:html-table-cell-data (gnc:html-table-get-cell test-table 2 1))) "Row 3 Col 1")
+ )
+ (and
+ (gnc:html-table-remove-last-row! test-table) ;; -> (("Row 2") ("Row 1"))
+ (not (gnc:html-table-append-column! test-table '("Col A" "Col B" "Col C"))) ;; -> (("Col C") ("Row 2" "Col B") ("Row 1" "Col A"))
+ (string=? (gnc:html-table-get-cell test-table 0 0) "Row 1")
+ (string=? (gnc:html-table-get-cell test-table 1 0) "Row 2")
+ ;;(string=? (gnc:html-table-get-cell test-table 2 0) "Col C") ;; -> error: "Value out of range"
+ ;; Bug: the row counter has not been adjusted, should be three
+ )
+ (string=? (string-concatenate (gnc:html-document-tree-collapse (gnc:html-table-render test-table test-doc)))
+ "<table><caption><boolean> #t</caption>\n<tbody><tr><td><string> Row 1</td>\n<td><string> Col A</td>\n</tr>\n<tr><td><string> Row 2</td>\n<td><string> Col B</td>\n</tr>\n<tr><td><string> Col C</td>\n</tr>\n</tbody>\n</table>\n")
+ )
+ )
+)
Summary of changes:
gnucash/report/report-system/html-document.scm | 31 +-
gnucash/report/report-system/html-table.scm | 7 +-
gnucash/report/report-system/test/CMakeLists.txt | 1 +
.../report/report-system/test/test-report-html.scm | 779 +++++++++++++++++++++
4 files changed, 798 insertions(+), 20 deletions(-)
create mode 100644 gnucash/report/report-system/test/test-report-html.scm
More information about the gnucash-changes
mailing list