diff --git a/gnucash/report/report-system/test/test-report-html.scm b/gnucash/report/report-system/test/test-report-html.scm index 32cc827b89..11a265a3b1 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) - "\n\n\n\n\n\n" - ;; BUG?: - ;; this code looks ugly - ;; - ;; - ;; - ;; - ;; - ;; + (string=? + (gnc:html-document-render test-doc) +"\n\ +\n\ +\n\ +\n\ +\n\ +\n") + ;; BUG?: + ;; this code looks ugly + ;; + ;; + ;; + ;; + ;; + ;; - ;; BUG?: - ;; There is no way to suppress the header, (not (null? headers?)) is always true + ;; 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 "\n")))) - ;; should be this - ;; (if (not (string-null? title)) - ;; (push (list "" title "\n"))) + ;; 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 "\n")))) + ;; should be this + ;; (if (not (string-null? title)) + ;; (push (list "" 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\n\n" - ) + (string=? + (gnc:html-document-render test-doc) +"\n\ +\n\ +\n\ +\n\ +HTML Document Title\n\ +\n") ) ) ) @@ -86,8 +98,17 @@ ) ) - (string=? (gnc:html-document-render test-doc) "\n\n\n\n HTML Plain Text Body 1234567890 #t (a b c d)\n\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) +"\n\ +\n\ +\n\ +\n\ + HTML Plain Text Body 1234567890\ + #t (a b c d)\n\ +\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) "\n\n\n\n HTML Text Body - Part 1. Part 2.HTML Text with number 7 in decimal format.HTML Text with number 8.8 in float format.HTML Text with boolean #f.HTML Text with literal text123.HTML Text with generic (a b c d).

HTML Text Paragraph

\n HTML Text Typewriter\n HTML Text Emphasized\n HTML Text Bold\n HTML Text Italic\n

HTML Text Heading1

\n

HTML Text Heading2

\n

HTML Text Heading3

\n
HTML Text Linebreak
HTML Text Headrow HTML Text Unsorted List
  • Item1
    • \n
  • Item2
    • \n
\n HTML Text Anchor Description\n\"GunCash\n\n") - + (string=? + (gnc:html-document-render test-doc) +"\n\ +\n\ +\n\ +\n\ + HTML Text Body - Part 1.\ + Part 2.HTML Text with number 7 in decimal format.\ +HTML Text with number 8.8 in float format.\ +HTML Text with boolean #f.\ +HTML Text with literal text123.\ +HTML Text with generic (a b c d).\ +

HTML Text Paragraph

\n\ + HTML Text Typewriter\n\ + HTML Text Emphasized\n\ + HTML Text Bold\n\ + HTML Text Italic\n\ +

HTML Text Heading1

\n\ +

HTML Text Heading2

\n\ +

HTML Text Heading3

\n\ +
HTML Text Linebreak\ +
HTML Text Headrow\ + HTML Text Unsorted List
  • Item1
    • \n\ +
  • Item2
    • \n\ +
\n\ + HTML Text Anchor Description\n\ +\"GunCash\n\ +\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))) - " HTML Table Cell obj1 obj2 123 #t (a b c d)\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))) +"\ + HTML Table Cell\ + obj1\ + obj2 123\ + #t\ + (a b c d)\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))) - "\n\n\n\n\n\n\n\n\n\n
#t
Row 1 Col A
Row 2 Col B
Col C
\n") + (string=? + (string-concatenate + (gnc:html-document-tree-collapse + (gnc:html-table-render test-table test-doc))) +"\n\ +\n\ +\n\ +\n\ +\n\ +\n\ +\n\ +\n\ +\n\ +\n\ +
#t
Row 1 Col A
Row 2 Col B
Col C
\n") ) ) )