mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
test-report-html.scm reformatted after review PR#391 (major update)
This commit is contained in:
Carsten Rinke
Geert Janssens
parent
b0c5381cee
commit
af0d7bd9f5
@ -12,190 +12,544 @@
|
|||||||
(test-begin "Testing/Temporary/test-report-html")
|
(test-begin "Testing/Temporary/test-report-html")
|
||||||
;; if (test-runner-factory gnc:test-runner) is commented out, this
|
;; if (test-runner-factory gnc:test-runner) is commented out, this
|
||||||
;; will create Testing/Temporary/test-report-html.log
|
;; will create Testing/Temporary/test-report-html.log
|
||||||
(test-assert "HTML Document Definition" (test-check1))
|
(test-html-document-defintion)
|
||||||
(test-assert "HTML Objects Definition for literals" (test-check2))
|
(test-html-objects-definition-for-literals)
|
||||||
(test-assert "HTML Text Object" (test-check3))
|
(test-html-objects)
|
||||||
(test-assert "HTML Table Cell" (test-check4))
|
(test-html-cells)
|
||||||
(test-assert "HTML Table" (test-check5))
|
(test-html-table)
|
||||||
(test-end "Testing/Temporary/test-report-html")
|
(test-end "Testing/Temporary/test-report-html")
|
||||||
)
|
)
|
||||||
|
|
||||||
;; -----------------------------------------------------------------------
|
(define html-doc-header-empty-title
|
||||||
|
|
||||||
(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\
|
"<html>\n\
|
||||||
<head>\n\
|
<head>\n\
|
||||||
<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
|
<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
|
||||||
<title>\n\
|
<title>\n\
|
||||||
</title></head><body></body>\n\
|
</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\
|
||||||
|
</head><body>")
|
||||||
|
|
||||||
|
(define html-doc-no-header-empty-body
|
||||||
|
"<body></body>\n")
|
||||||
|
|
||||||
|
(define html-doc-tail
|
||||||
|
"</body>\n\
|
||||||
</html>\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?:
|
(define (test-html-document-defintion)
|
||||||
;; There is no way to suppress the title, (if (title)) is always true
|
|
||||||
;; BUG?:
|
(test-begin "HTML Document - Basic Creation")
|
||||||
;; title is already defined, no reason to make a (let) statement
|
|
||||||
;; so this
|
(let (
|
||||||
;; (let ((title (gnc:html-document-title doc)))
|
(test-doc (gnc:make-html-document))
|
||||||
;; (if title
|
)
|
||||||
;; (push (list "</title>" title "<title>\n"))))
|
|
||||||
;; should be this
|
(test-assert "HTML Document - check predicate" (gnc:html-document? test-doc))
|
||||||
;; (if (not (string-null? title))
|
(test-assert "HTML Document - default no stylesheet" (not (gnc:html-document-style-sheet test-doc)))
|
||||||
;; (push (list "</title>" title "<title>\n")))
|
(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)
|
||||||
|
)
|
||||||
|
|
||||||
|
(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")
|
(gnc:html-document-set-title! test-doc "HTML Document Title")
|
||||||
(string=?
|
(test-equal "HTML Document - Render with title"
|
||||||
(gnc:html-document-render test-doc)
|
|
||||||
"<html>\n\
|
"<html>\n\
|
||||||
<head>\n\
|
<head>\n\
|
||||||
<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
|
<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n\
|
||||||
<title>\n\
|
<title>\n\
|
||||||
HTML Document Title</title></head><body></body>\n\
|
HTML Document Title</title></head><body></body>\n\
|
||||||
</html>\n")
|
</html>\n"
|
||||||
|
(gnc:html-document-render test-doc)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(test-end "HTML Document - Creation")
|
||||||
)
|
)
|
||||||
|
|
||||||
;; -----------------------------------------------------------------------
|
;; -----------------------------------------------------------------------
|
||||||
|
|
||||||
(define (test-check2)
|
(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 (
|
(let (
|
||||||
(test-doc (gnc:make-html-document))
|
(test-doc (gnc:make-html-document))
|
||||||
)
|
)
|
||||||
|
|
||||||
(gnc:html-document-append-objects! test-doc
|
(gnc:html-document-append-objects! test-doc
|
||||||
(list
|
(list
|
||||||
(gnc:make-html-object "HTML Plain Text Body")
|
(gnc:make-html-object "HTML Plain Text Body")
|
||||||
(gnc:make-html-object 1234567890)
|
)
|
||||||
(gnc:make-html-object #t)
|
)
|
||||||
(gnc:make-html-object #f)
|
(gnc:html-document-render test-doc)
|
||||||
(gnc:make-html-object '(a b c d))
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
(string=?
|
(test-equal "HTML Object for Numbers"
|
||||||
(gnc:html-document-render test-doc)
|
(string-append html-doc-header-empty-title "<number> 1234567890" html-doc-tail)
|
||||||
"<html>\n\
|
(let (
|
||||||
<head>\n\
|
(test-doc (gnc:make-html-document))
|
||||||
<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
|
|
||||||
)
|
)
|
||||||
|
(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-check3)
|
(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 (
|
(let (
|
||||||
(test-doc (gnc:make-html-document))
|
(test-doc (gnc:make-html-document))
|
||||||
)
|
)
|
||||||
|
|
||||||
(gnc:html-document-append-objects! test-doc
|
(gnc:html-document-append-objects! test-doc
|
||||||
(list
|
(list
|
||||||
(gnc:make-html-text
|
(gnc:make-html-text
|
||||||
"HTML Text Body - Part 1."
|
"HTML Text Body - Part 1."
|
||||||
"Part 2."
|
"Part 2."
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup/format
|
(gnc:html-markup/format
|
||||||
"HTML Text with number ~a in decimal format."
|
"HTML Text with number ~a in decimal format."
|
||||||
7
|
7
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup/format
|
(gnc:html-markup/format
|
||||||
"HTML Text with number ~a in float format."
|
"HTML Text with number ~a in float format."
|
||||||
8.8
|
8.8
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup/format
|
(gnc:html-markup/format
|
||||||
"HTML Text with boolean ~a." #f
|
"HTML Text with boolean ~a."
|
||||||
|
#f
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup/format
|
(gnc:html-markup/format
|
||||||
"HTML Text with literal ~a."
|
"HTML Text with literal ~a."
|
||||||
"text123"
|
"text123"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup/format
|
(gnc:html-markup/format
|
||||||
"HTML Text with generic ~a."
|
"HTML Text with generic ~a."
|
||||||
'(a b c d)
|
'(a b c d)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-p "HTML Text Paragraph")
|
(gnc:html-markup-p "HTML Text Paragraph")
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-tt "HTML Text Typewriter")
|
(gnc:html-markup-tt "HTML Text Typewriter")
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-em "HTML Text Emphasized")
|
(gnc:html-markup-em "HTML Text Emphasized")
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-b "HTML Text Bold")
|
(gnc:html-markup-b "HTML Text Bold")
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-i "HTML Text Italic")
|
(gnc:html-markup-i "HTML Text Italic")
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-h1 "HTML Text Heading1")
|
(gnc:html-markup-h1 "HTML Text Heading1")
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-h2 "HTML Text Heading2")
|
(gnc:html-markup-h2 "HTML Text Heading2")
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-h3 "HTML Text Heading3")
|
(gnc:html-markup-h3 "HTML Text Heading3")
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-br)
|
(gnc:html-markup-br)
|
||||||
"HTML Text Linebreak"
|
"HTML Text Linebreak"
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-hr)
|
(gnc:html-markup-hr)
|
||||||
"HTML Text Headrow"
|
"HTML Text Headrow"
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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
|
(gnc:make-html-text
|
||||||
"HTML Text Unsorted List"
|
"HTML Text Unsorted List"
|
||||||
(gnc:html-markup-ul '("Item1" "Item2"))
|
(gnc:html-markup-ul '("Item1" "Item2"))
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-anchor
|
(gnc:html-markup-anchor
|
||||||
"HTML Text Anchor Link"
|
"HTML Text Anchor Link"
|
||||||
"HTML Text Anchor Description"
|
"HTML Text Anchor Description"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(gnc:html-document-render test-doc)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(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:make-html-text
|
||||||
(gnc:html-markup-img
|
(gnc:html-markup-img
|
||||||
"http://www.gnucash.org/images/banner5.png"
|
"http://www.gnucash.org/images/banner5.png"
|
||||||
@ -206,42 +560,30 @@ HTML Document Title</title></head><body></body>\n\
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
(string=?
|
|
||||||
(gnc:html-document-render test-doc)
|
(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)
|
(define (test-html-cells)
|
||||||
|
|
||||||
|
(test-begin "HTML Cells")
|
||||||
|
|
||||||
|
(test-expect-fail 1)
|
||||||
|
(test-equal "HTML Cell Creation - Bug 796828"
|
||||||
|
|
||||||
|
"<tag rowspan=\"2\" colspan=\"3\">\
|
||||||
|
<string> HTML Table Cell\
|
||||||
|
<string> obj1\
|
||||||
|
<string> obj2<number> 123\
|
||||||
|
<boolean> #t\
|
||||||
|
<boolean> #f\
|
||||||
|
<generic> (a b c d)</tag>\n"
|
||||||
|
|
||||||
(let (
|
(let (
|
||||||
(test-doc (gnc:make-html-document))
|
(test-doc (gnc:make-html-document))
|
||||||
(html-table-cell (gnc:make-html-table-cell "HTML Table Cell"))
|
(html-table-cell (gnc:make-html-table-cell "HTML Table Cell"))
|
||||||
@ -252,29 +594,20 @@ width=\"72\" height=\"48\" alt=\"GunCash web site\" /></body>\n\
|
|||||||
(gnc:html-table-cell-append-objects!
|
(gnc:html-table-cell-append-objects!
|
||||||
html-table-cell "obj1" "obj2" 123 #t #f '(a b c d)
|
html-table-cell "obj1" "obj2" 123 #t #f '(a b c d)
|
||||||
)
|
)
|
||||||
|
|
||||||
(string=?
|
|
||||||
(string-concatenate
|
(string-concatenate
|
||||||
(gnc:html-document-tree-collapse
|
(gnc:html-document-tree-collapse
|
||||||
(gnc:html-table-cell-render html-table-cell test-doc)))
|
(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
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(test-end "HTML Cells")
|
||||||
|
)
|
||||||
|
|
||||||
;; -----------------------------------------------------------------------
|
;; -----------------------------------------------------------------------
|
||||||
|
|
||||||
(define (test-check5)
|
(define (test-html-table)
|
||||||
(let (
|
|
||||||
(test-doc (gnc:make-html-document))
|
|
||||||
(test-table (gnc:make-html-table))
|
|
||||||
)
|
|
||||||
|
|
||||||
;; A table is list of rows in reverse order
|
;; A table is list of rows in reverse order
|
||||||
;; Each row is a list of cells
|
;; Each row is a list of cells
|
||||||
@ -286,95 +619,174 @@ width=\"72\" height=\"48\" alt=\"GunCash web site\" /></body>\n\
|
|||||||
;; The cell in row 1 and col 1 is r1c1. Each cell should hold
|
;; The cell in row 1 and col 1 is r1c1. Each cell should hold
|
||||||
;; a html cell object (see previous test case).
|
;; a html cell object (see previous test case).
|
||||||
|
|
||||||
|
(test-begin "HTML Tables - without style sheets")
|
||||||
|
|
||||||
|
(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
|
;; change the default settings just to see what effect it has
|
||||||
;;(gnc:html-table-set-col-headers! test-table #t)
|
;;(gnc:html-table-set-col-headers! test-table #t)
|
||||||
;; -> this make (gnc:html-table-render test-table test-doc) crash
|
;; -> this make (gnc:html-table-render test-table test-doc) crash
|
||||||
;; col-headers must be #f or a list
|
;; col-headers must be #f or a list
|
||||||
(gnc:html-table-set-row-headers! test-table #t)
|
(gnc:html-table-set-row-headers! test-table #t)
|
||||||
(gnc:html-table-set-caption! test-table #t)
|
(gnc:html-table-set-caption! test-table #t)
|
||||||
|
(gnc:html-table-append-row! test-table "Row 1")
|
||||||
(and
|
(gnc:html-table-append-row! test-table "Row 2")
|
||||||
(= (gnc:html-table-append-row! test-table "Row 1") 1)
|
(test-equal "Check Num Rows after append row"
|
||||||
(= (gnc:html-table-append-row! test-table "Row 2") 2)
|
2
|
||||||
;; data is now: (("Row 2") ("Row 1"))
|
(gnc:html-table-num-rows test-table)
|
||||||
(= (gnc:html-table-num-rows test-table) 2)
|
)
|
||||||
(= (length (gnc:html-table-remove-last-row! test-table)) 1)
|
(test-equal "Check data after append row"
|
||||||
(= (length (gnc:html-table-remove-last-row! test-table)) 0)
|
'(("Row 2") ("Row 1"))
|
||||||
;; simple negative test: try to remove non existing row
|
(gnc:html-table-data test-table)
|
||||||
(null? (gnc:html-table-remove-last-row! test-table))
|
)
|
||||||
|
)
|
||||||
(= (gnc:html-table-append-row! test-table "Row 2") 1)
|
(test-end "Append Rows")
|
||||||
(= (gnc:html-table-prepend-row! test-table "Row 1") 2)
|
(test-begin "Remove Rows")
|
||||||
(= (gnc:html-table-prepend-row! test-table "Row 0") 3)
|
(let (
|
||||||
(= (gnc:html-table-prepend-row! test-table "Row -1") 4)
|
(test-doc (gnc:make-html-document))
|
||||||
;; BUG: data is now: (("Row 2") "Row 1" "Row 0" "Row -1")
|
(test-table (gnc:make-html-table))
|
||||||
;; for (gnc:html-table-get-cell test-table 2 0)
|
)
|
||||||
;; this leads to error:
|
;; change the default settings just to see what effect it has
|
||||||
;; (wrong-type-arg "length"
|
;;(gnc:html-table-set-col-headers! test-table #t)
|
||||||
;; "Wrong type argument in position ~A: ~S" (1 "Row 1") ("Row 1"))
|
;; -> this make (gnc:html-table-render test-table test-doc) crash
|
||||||
|
;; col-headers must be #f or a list
|
||||||
;; BUG: gnc:html-table-prepend-row! updates
|
(gnc:html-table-set-row-headers! test-table #t)
|
||||||
;; the row-markup hash table which is
|
(gnc:html-table-set-caption! test-table #t)
|
||||||
;; - not updated on deletion of a row
|
(gnc:html-table-append-row! test-table "Row 1")
|
||||||
;; - not updated anywhere else in the code
|
(gnc:html-table-append-row! test-table "Row 2")
|
||||||
;; - not used anywhere else in GnuCash
|
(gnc:html-table-remove-last-row! test-table)
|
||||||
;; --> should be removed
|
(test-equal "Check Num Rows after remove row"
|
||||||
;; (same goes for gnc:html-table-row-markup,
|
1
|
||||||
;; gnc:html-table-set-row-markup-table! gnc:html-table-set-row-markup!)
|
(gnc:html-table-num-rows test-table)
|
||||||
|
)
|
||||||
;; Reset table data due to bug above:
|
(test-equal "Check data after remove row"
|
||||||
(gnc:html-table-set-data! test-table '())
|
'(("Row 1"))
|
||||||
|
(gnc:html-table-data test-table)
|
||||||
;; luckily for testng, this is not internal - BUG?
|
)
|
||||||
(gnc:html-table-set-num-rows-internal! test-table 0)
|
(gnc:html-table-remove-last-row! test-table)
|
||||||
|
(test-equal "Negative Test: Remove non-existing rows" '() (gnc:html-table-remove-last-row! test-table))
|
||||||
(= (gnc:html-table-append-row! test-table "Row 1") 1)
|
)
|
||||||
(= (gnc:html-table-append-row! test-table "Row 2") 2)
|
(test-end "Remove Rows")
|
||||||
(= (gnc:html-table-append-row! test-table "Row 3") 3)
|
(test-begin "Prepend Rows")
|
||||||
(string=? (gnc:html-table-get-cell test-table 2 0) "Row 3")
|
(let (
|
||||||
(not (gnc:html-table-get-cell test-table 1 1)) ;; simple negative test
|
(test-doc (gnc:make-html-document))
|
||||||
(not (gnc:html-table-get-cell test-table -1 0)) ;; simple negative test
|
(test-table (gnc:make-html-table))
|
||||||
(and
|
)
|
||||||
(gnc:html-table-set-cell! test-table 2 1 "Row 3 Col 1")
|
;; change the default settings just to see what effect it has
|
||||||
(string=?
|
;;(gnc:html-table-set-col-headers! test-table #t)
|
||||||
(car
|
;; -> this make (gnc:html-table-render test-table test-doc) crash
|
||||||
(gnc:html-table-cell-data
|
;; 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)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(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)
|
(gnc:html-table-get-cell test-table 2 1)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
"Row 3 Col 1")
|
(test-end "Append Columns")
|
||||||
|
(test-begin "Table Rendering")
|
||||||
|
(let (
|
||||||
|
(test-doc (gnc:make-html-document))
|
||||||
|
(test-table (gnc:make-html-table))
|
||||||
)
|
)
|
||||||
(and
|
;; change the default settings just to see what effect it has
|
||||||
(gnc:html-table-remove-last-row! test-table) ;; -> (("Row 2") ("Row 1"))
|
;;(gnc:html-table-set-col-headers! test-table #t)
|
||||||
|
;; -> this make (gnc:html-table-render test-table test-doc) crash
|
||||||
(not
|
;; col-headers must be #f or a list
|
||||||
(gnc:html-table-append-column!
|
(gnc:html-table-set-row-headers! test-table #t)
|
||||||
test-table
|
(gnc:html-table-set-caption! test-table #t)
|
||||||
'("Col A" "Col B" "Col C")
|
(gnc:html-table-append-row! test-table "Row 1")
|
||||||
)
|
(gnc:html-table-append-row! test-table "Row 2")
|
||||||
) ;; -> (("Col C") ("Row 2" "Col B") ("Row 1" "Col A"))
|
(gnc:html-table-append-column! test-table '("Col A" "Col B"))
|
||||||
|
(test-equal "Check table rendering result"
|
||||||
(string=? (gnc:html-table-get-cell test-table 0 0) "Row 1")
|
"<table><caption><boolean> #t</caption>\n\
|
||||||
(string=? (gnc:html-table-get-cell test-table 1 0) "Row 2")
|
<tbody>\
|
||||||
;;(string=? (gnc:html-table-get-cell test-table 2 0) "Col C")
|
<tr><td><string> Row 1</td>\n<td><string> Col A</td>\n</tr>\n\
|
||||||
;; -> error: "Value out of range"
|
<tr><td><string> Row 2</td>\n<td><string> Col B</td>\n</tr>\n\
|
||||||
;; Bug: the row counter has not been adjusted, should be three
|
</tbody>\n\
|
||||||
)
|
</table>\n"
|
||||||
(string=?
|
|
||||||
(string-concatenate
|
(string-concatenate
|
||||||
(gnc:html-document-tree-collapse
|
(gnc:html-document-tree-collapse
|
||||||
(gnc:html-table-render test-table test-doc)))
|
(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")
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
|
(test-end "Table Rendering")
|
||||||
|
|
||||||
|
(test-end "HTML Tables - without style sheets")
|
||||||
|
)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user