Changeset 12119 in project


Ignore:
Timestamp:
10/07/08 08:59:25 (12 years ago)
Author:
felix winkelmann
Message:

modularized; added test-suite

Location:
release/4/htmlprag
Files:
2 added
3 edited

Legend:

Unmodified
Added
Removed

  • release/4/htmlprag/htmlprag.meta

    r9305 r12119  
    44 (synopsis "A permissive HTML parser")
    55 (license "LGPL-2.1")
    6  (needs syntax-case)
    76 (category web)
    87 (doc-from-wiki)
     8 (test-depends testeez)
    99 (author "Neil W. Van Dyke")
    1010 (files "htmlprag.setup" "htmlprag.scm" "htmlprag.html"))

  • release/4/htmlprag/htmlprag.scm

    r4599 r12119  
    1212
    1313(declare
    14  (export shtml-comment-symbol shtml-decl-symbol shtml-empty-symbol
    15          shtml-end-symbol shtml-entity-symbol shtml-pi-symbol
    16          shtml-start-symbol shtml-text-symbol shtml-top-symbol
    17          shtml-named-char-id shtml-numeric-char-id make-shtml-entity
    18          shtml-entity-value make-html-tokenizer tokenize-html
    19          shtml-token-kind parse-html/tokenizer
    20          html->sxml-0nf html->sxml-1nf html->sxml-2nf
    21          html->sxml html->shtml write-shtml-as-html shtml->html)
    2214 (fixnum))
     15
     16
     17(module htmlprag
     18
     19 (shtml-comment-symbol
     20  shtml-decl-symbol shtml-empty-symbol
     21  shtml-end-symbol shtml-entity-symbol shtml-pi-symbol
     22  shtml-start-symbol shtml-text-symbol shtml-top-symbol
     23  shtml-named-char-id shtml-numeric-char-id make-shtml-entity
     24  shtml-entity-value make-html-tokenizer tokenize-html
     25  shtml-token-kind parse-html/tokenizer
     26  html->sxml-0nf html->sxml-1nf html->sxml-2nf
     27  html->sxml html->shtml write-shtml-as-html shtml->html)
     28
     29 (import scheme chicken)
     30
    2331
    2432;;; @legal
    … …  
    3341;;; other license options and consulting, contact the author.
    3442;;; @end legal
    35 
    36 (define-syntax %htmlprag:testeez
    37   (syntax-rules () ((_ x ...)
    38                     ;; (testeez x ...)
    39                     (error "Tests disabled.")
    40                     )))
    4143
    4244;;; @section Introduction
    … …  
    16321634    (%htmlprag:gosc os)))
    16331635
    1634 ;;; @section Tests
    1635 
    1636 ;;; The HtmlPrag test suite can be enabled by editing the source code file and
    1637 ;;; loading @uref{http://www.neilvandyke.org/testeez/, Testeez}.
    1638 
    1639 (define (%htmlprag:test)
    1640   (%htmlprag:testeez
    1641    "HtmlPrag"
    1642 
    1643    (test-define "" lf (string (%htmlprag:a2c 10)))
    1644 
    1645    (test/equal "" (html->shtml "<a>>") `(,shtml-top-symbol (a ">")))
    1646    (test/equal "" (html->shtml "<a<>") `(,shtml-top-symbol (a "<" ">")))
    1647 
    1648    (test/equal "" (html->shtml "<>")      `(,shtml-top-symbol "<" ">"))
    1649    (test/equal "" (html->shtml "< >")     `(,shtml-top-symbol "<" ">"))
    1650    (test/equal "" (html->shtml "< a>")    `(,shtml-top-symbol (a)))
    1651    (test/equal "" (html->shtml "< a / >") `(,shtml-top-symbol (a)))
    1652 
    1653    (test/equal "" (html->shtml "<a<")  `(,shtml-top-symbol (a "<")))
    1654    (test/equal "" (html->shtml "<a<b") `(,shtml-top-symbol (a (b))))
    1655 
    1656    (test/equal "" (html->shtml "><a>") `(,shtml-top-symbol ">" (a)))
    1657 
    1658    (test/equal "" (html->shtml "</>") `(,shtml-top-symbol))
    1659 
    1660    (test/equal "" (html->shtml "<\">") `(,shtml-top-symbol "<" "\"" ">"))
    1661 
    1662    (test/equal ""
    1663                (html->shtml (string-append "<a>xxx<plaintext>aaa" lf
    1664                                            "bbb" lf
    1665                                            "c<c<c"))
    1666                `(,shtml-top-symbol
    1667                  (a "xxx" (plaintext ,(string-append "aaa" lf)
    1668                                      ,(string-append "bbb" lf)
    1669                                      "c<c<c"))))
    1670 
    1671    (test/equal ""
    1672                (html->shtml "aaa<!-- xxx -->bbb")
    1673                `(,shtml-top-symbol
    1674                  "aaa" (,shtml-comment-symbol " xxx ")   "bbb"))
    1675 
    1676    (test/equal ""
    1677                (html->shtml "aaa<! -- xxx -->bbb")
    1678                `(,shtml-top-symbol
    1679                  "aaa" (,shtml-comment-symbol " xxx ")   "bbb"))
    1680 
    1681    (test/equal ""
    1682                (html->shtml "aaa<!-- xxx --->bbb")
    1683                `(,shtml-top-symbol
    1684                  "aaa" (,shtml-comment-symbol " xxx -")  "bbb"))
    1685 
    1686    (test/equal ""
    1687                (html->shtml "aaa<!-- xxx ---->bbb")
    1688                `(,shtml-top-symbol
    1689                  "aaa" (,shtml-comment-symbol " xxx --") "bbb"))
    1690 
    1691    (test/equal ""
    1692                (html->shtml "aaa<!-- xxx -y-->bbb")
    1693                `(,shtml-top-symbol
    1694                  "aaa" (,shtml-comment-symbol " xxx -y") "bbb"))
    1695 
    1696    (test/equal ""
    1697                (html->shtml "aaa<!----->bbb")
    1698                `(,shtml-top-symbol
    1699                  "aaa" (,shtml-comment-symbol "-")       "bbb"))
    1700 
    1701    (test/equal ""
    1702                (html->shtml "aaa<!---->bbb")
    1703                `(,shtml-top-symbol
    1704                  "aaa" (,shtml-comment-symbol "")        "bbb"))
    1705 
    1706    (test/equal ""
    1707                (html->shtml "aaa<!--->bbb")
    1708                `(,shtml-top-symbol "aaa" (,shtml-comment-symbol "->bbb")))
    1709 
    1710    (test/equal "" (html->shtml "<hr>")   `(,shtml-top-symbol (hr)))
    1711    (test/equal "" (html->shtml "<hr/>")  `(,shtml-top-symbol (hr)))
    1712    (test/equal "" (html->shtml "<hr />") `(,shtml-top-symbol (hr)))
    1713 
    1714    (test/equal ""
    1715                (html->shtml "<hr noshade>")
    1716                `(,shtml-top-symbol (hr (@ (noshade)))))
    1717    (test/equal ""
    1718                (html->shtml "<hr noshade/>")
    1719                `(,shtml-top-symbol (hr (@ (noshade)))))
    1720    (test/equal ""
    1721                (html->shtml "<hr noshade />")
    1722                `(,shtml-top-symbol (hr (@ (noshade)))))
    1723    (test/equal ""
    1724                (html->shtml "<hr noshade / >")
    1725                `(,shtml-top-symbol (hr (@ (noshade)))))
    1726    (test/equal ""
    1727                (html->shtml "<hr noshade=1 />")
    1728                `(,shtml-top-symbol (hr (@ (noshade "1")))))
    1729    (test/equal ""
    1730                (html->shtml "<hr noshade=1/>")
    1731                `(,shtml-top-symbol (hr (@ (noshade "1/")))))
    1732 
    1733    (test/equal ""
    1734                (html->shtml "<q>aaa<p/>bbb</q>ccc</p>ddd")
    1735                `(,shtml-top-symbol (q "aaa" (p) "bbb") "ccc" "ddd"))
    1736 
    1737    (test/equal "" (html->shtml "&lt;") `(,shtml-top-symbol "<"))
    1738    (test/equal "" (html->shtml "&gt;") `(,shtml-top-symbol ">"))
    1739 
    1740    (test/equal ""
    1741                (html->shtml "Gilbert &amp; Sullivan")
    1742                `(,shtml-top-symbol "Gilbert & Sullivan"))
    1743    (test/equal ""
    1744                (html->shtml "Gilbert &amp Sullivan")
    1745                `(,shtml-top-symbol "Gilbert & Sullivan"))
    1746    (test/equal ""
    1747                (html->shtml "Gilbert & Sullivan")
    1748                `(,shtml-top-symbol "Gilbert & Sullivan"))
    1749 
    1750    (test/equal ""
    1751                (html->shtml "Copyright &copy; Foo")
    1752                `(,shtml-top-symbol "Copyright "
    1753                                    (& ,(string->symbol "copy"))
    1754                                    " Foo"))
    1755    (test/equal ""
    1756                (html->shtml "aaa&copy;bbb")
    1757                `(,shtml-top-symbol
    1758                  "aaa" (& ,(string->symbol "copy")) "bbb"))
    1759    (test/equal ""
    1760                (html->shtml "aaa&copy")
    1761                `(,shtml-top-symbol
    1762                  "aaa" (& ,(string->symbol "copy"))))
    1763 
    1764    (test/equal "" (html->shtml "&#42;")  `(,shtml-top-symbol "*"))
    1765    (test/equal "" (html->shtml "&#42")   `(,shtml-top-symbol "*"))
    1766    (test/equal "" (html->shtml "&#42x")  `(,shtml-top-symbol "*x"))
    1767    (test/equal "" (html->shtml "&#151")  `(,shtml-top-symbol
    1768                                            (& 151)
    1769                                            ;; ,(string (%htmlprag:a2c 151))
    1770                                            ))
    1771    (test/equal "" (html->shtml "&#1000") `(,shtml-top-symbol (& 1000)))
    1772    (test/equal "" (html->shtml "&#x42")  `(,shtml-top-symbol "B"))
    1773    (test/equal "" (html->shtml "&#xA2")  `(,shtml-top-symbol
    1774                                            (& 162)
    1775                                            ;; ,(string (%htmlprag:a2c 162))
    1776                                            ))
    1777    (test/equal "" (html->shtml "&#xFF")  `(,shtml-top-symbol
    1778                                            (& 255)
    1779                                            ;; ,(string (%htmlprag:a2c 255))
    1780                                            ))
    1781    (test/equal "" (html->shtml "&#x100") `(,shtml-top-symbol (& 256)))
    1782    (test/equal "" (html->shtml "&#X42")  `(,shtml-top-symbol "B"))
    1783    (test/equal "" (html->shtml "&42;")   `(,shtml-top-symbol "&42;"))
    1784 
    1785    (test/equal ""
    1786                (html->shtml (string-append "aaa&copy;bbb&amp;ccc&lt;ddd&&gt;"
    1787                                            "eee&#42;fff&#1000;ggg&#x5a;hhh"))
    1788                `(,shtml-top-symbol
    1789                  "aaa"
    1790                  (& ,(string->symbol "copy"))
    1791                  "bbb&ccc<ddd&>eee*fff"
    1792                  (& 1000)
    1793                  "gggZhhh"))
    1794 
    1795    (test/equal ""
    1796                (html->shtml
    1797                 (string-append
    1798                  "<IMG src=\"http://e.e/aw/pics/listings/"
    1799                  "ebayLogo_38x16.gif\" border=0 width=\"38\" height=\"16\" "
    1800                  "HSPACE=5 VSPACE=0\">2</FONT>"))
    1801                `(,shtml-top-symbol
    1802                  (img (@
    1803                        (src
    1804                         "http://e.e/aw/pics/listings/ebayLogo_38x16.gif")
    1805                        (border "0") (width "38") (height "16")
    1806                        (hspace "5") (vspace "0")))
    1807                  "2"))
    1808 
    1809    (test/equal ""
    1810                (html->shtml "<aaa bbb=ccc\"ddd>eee")
    1811                `(,shtml-top-symbol (aaa (@ (bbb "ccc") (ddd)) "eee")))
    1812    (test/equal ""
    1813                (html->shtml "<aaa bbb=ccc \"ddd>eee")
    1814                `(,shtml-top-symbol (aaa (@ (bbb "ccc") (ddd)) "eee")))
    1815 
    1816    (test/equal ""
    1817                (html->shtml
    1818                 (string-append
    1819                  "<HTML><Head><Title>My Title</Title></Head>"
    1820                  "<Body BGColor=\"white\" Foo=42>"
    1821                  "This is a <B><I>bold-italic</B></I> test of </Erk>"
    1822                  "broken HTML.<br>Yes it is.</Body></HTML>"))
    1823                `(,shtml-top-symbol
    1824                  (html (head (title "My Title"))
    1825                        (body (@ (bgcolor "white") (foo "42"))
    1826                              "This is a "
    1827                              (b (i "bold-italic"))
    1828                              " test of "
    1829                              "broken HTML."
    1830                              (br)
    1831                              "Yes it is."))))
    1832 
    1833    (test/equal ""
    1834                (html->shtml
    1835                 (string-append
    1836                  "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""
    1837                  " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"))
    1838                `(,shtml-top-symbol
    1839                  (,shtml-decl-symbol
    1840                   ,(string->symbol "DOCTYPE")
    1841                   html
    1842                   ,(string->symbol "PUBLIC")
    1843                   "-//W3C//DTD XHTML 1.0 Strict//EN"
    1844                   "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd")))
    1845 
    1846    (test/equal ""
    1847                (html->shtml
    1848                 (string-append
    1849                  "<html xmlns=\"http://www.w3.org/1999/xhtml\" "
    1850                  "xml:lang=\"en\" "
    1851                  "lang=\"en\">"))
    1852                `(,shtml-top-symbol
    1853                  (html (@ (xmlns "http://www.w3.org/1999/xhtml")
    1854                           (xml:lang "en") (lang "en")))))
    1855 
    1856    (test/equal
    1857     ""
    1858     (html->shtml
    1859      (string-append
    1860       "<html:html xmlns:html=\"http://www.w3.org/TR/REC-html40\">"
    1861       "<html:head><html:title>Frobnostication</html:title></html:head>"
    1862       "<html:body><html:p>Moved to <html:a href=\"http://frob.com\">"
    1863       "here.</html:a></html:p></html:body></html:html>"))
    1864     `(,shtml-top-symbol
    1865       (html (@ (xmlns:html "http://www.w3.org/TR/REC-html40"))
    1866             (head (title "Frobnostication"))
    1867             (body (p "Moved to "
    1868                      (a (@ (href "http://frob.com"))
    1869                         "here."))))))
    1870 
    1871    (test/equal ""
    1872                (html->shtml
    1873                 (string-append
    1874                  "<RESERVATION xmlns:HTML=\"http://www.w3.org/TR/REC-html40\">"
    1875                  "<NAME HTML:CLASS=\"largeSansSerif\">Layman, A</NAME>"
    1876                  "<SEAT CLASS=\"Y\" HTML:CLASS=\"largeMonotype\">33B</SEAT>"
    1877                  "<HTML:A HREF=\"/cgi-bin/ResStatus\">Check Status</HTML:A>"
    1878                  "<DEPARTURE>1997-05-24T07:55:00+1</DEPARTURE></RESERVATION>"))
    1879                `(,shtml-top-symbol
    1880                  (reservation (@ (,(string->symbol "xmlns:HTML")
    1881                                   "http://www.w3.org/TR/REC-html40"))
    1882                               (name (@ (class "largeSansSerif"))
    1883                                     "Layman, A")
    1884                               (seat (@ (class "Y") (class "largeMonotype"))
    1885                                     "33B")
    1886                               (a (@ (href "/cgi-bin/ResStatus"))
    1887                                  "Check Status")
    1888                               (departure "1997-05-24T07:55:00+1"))))
    1889 
    1890    (test/equal
    1891     ""
    1892     (html->shtml
    1893      (string-append
    1894       "<html><head><title></title><title>whatever</title></head><body>"
    1895       "<a href=\"url\">link</a><p align=center><ul compact style=\"aa\">"
    1896       "<p>BLah<!-- comment <comment> --> <i> italic <b> bold <tt> ened </i>"
    1897       " still &lt; bold </b></body><P> But not done yet..."))
    1898     `(,shtml-top-symbol
    1899       (html (head (title) (title "whatever"))
    1900             (body (a (@ (href "url")) "link")
    1901                   (p (@ (align "center"))
    1902                      (ul (@ (compact) (style "aa"))))
    1903                   (p "BLah"
    1904                      (,shtml-comment-symbol " comment <comment> ")
    1905                      " "
    1906                      (i " italic " (b " bold " (tt " ened ")))
    1907                      " still < bold "))
    1908             (p " But not done yet..."))))
    1909 
    1910    (test/equal ""
    1911                (html->shtml "<?xml version=\"1.0\" encoding=\"UTF-8\"?>")
    1912                `(,shtml-top-symbol
    1913                  (,shtml-pi-symbol xml "version=\"1.0\" encoding=\"UTF-8\"")))
    1914 
    1915    (test/equal ""
    1916                (html->shtml "<?php php_info(); ?>")
    1917                `(,shtml-top-symbol (,shtml-pi-symbol php "php_info(); ")))
    1918    (test/equal ""
    1919                (html->shtml "<?php php_info(); ?")
    1920                `(,shtml-top-symbol (,shtml-pi-symbol php "php_info(); ?")))
    1921    (test/equal ""
    1922                (html->shtml "<?php php_info(); ")
    1923                `(,shtml-top-symbol (,shtml-pi-symbol php "php_info(); ")))
    1924 
    1925    (test/equal ""
    1926                (html->shtml "<?foo bar ? baz > blort ?>")
    1927                `(,shtml-top-symbol
    1928                  (,shtml-pi-symbol foo "bar ? baz > blort ")))
    1929 
    1930    (test/equal ""
    1931                (html->shtml "<?foo b?>x")
    1932                `(,shtml-top-symbol (,shtml-pi-symbol foo "b") "x"))
    1933    (test/equal ""
    1934                (html->shtml "<?foo ?>x")
    1935                `(,shtml-top-symbol (,shtml-pi-symbol foo "")  "x"))
    1936    (test/equal ""
    1937                (html->shtml "<?foo ?>x")
    1938                `(,shtml-top-symbol (,shtml-pi-symbol foo "")  "x"))
    1939    (test/equal ""
    1940                (html->shtml "<?foo?>x")
    1941                `(,shtml-top-symbol (,shtml-pi-symbol foo "")  "x"))
    1942    (test/equal ""
    1943                (html->shtml "<?f?>x")
    1944                `(,shtml-top-symbol (,shtml-pi-symbol f   "")  "x"))
    1945    (test/equal ""
    1946                (html->shtml "<??>x")
    1947                `(,shtml-top-symbol (,shtml-pi-symbol #f  "")  "x"))
    1948    (test/equal ""
    1949                (html->shtml "<?>x")
    1950                `(,shtml-top-symbol (,shtml-pi-symbol #f  ">x")))
    1951 
    1952    (test/equal ""
    1953                (html->shtml "<foo bar=\"baz\">blort")
    1954                `(,shtml-top-symbol (foo (@ (bar "baz")) "blort")))
    1955    (test/equal ""
    1956                (html->shtml "<foo bar='baz'>blort")
    1957                `(,shtml-top-symbol (foo (@ (bar "baz")) "blort")))
    1958    (test/equal ""
    1959                (html->shtml "<foo bar=\"baz'>blort")
    1960                `(,shtml-top-symbol (foo (@ (bar "baz'>blort")))))
    1961    (test/equal ""
    1962                (html->shtml "<foo bar='baz\">blort")
    1963                `(,shtml-top-symbol (foo (@ (bar "baz\">blort")))))
    1964 
    1965    (test/equal ""
    1966                (html->shtml (string-append "<p>A</p>"
    1967                                            "<script>line0 <" lf
    1968                                            "line1" lf
    1969                                            "<line2></script>"
    1970                                            "<p>B</p>"))
    1971                `(,shtml-top-symbol (p "A")
    1972                                    (script ,(string-append "line0 <" lf)
    1973                                            ,(string-append "line1"   lf)
    1974                                            "<line2>")
    1975                                    (p "B")))
    1976 
    1977    (test/equal ""
    1978                (html->shtml "<xmp>a<b>c</XMP>d")
    1979                `(,shtml-top-symbol (xmp "a<b>c") "d"))
    1980    (test/equal ""
    1981                (html->shtml "<XMP>a<b>c</xmp>d")
    1982                `(,shtml-top-symbol (xmp "a<b>c") "d"))
    1983    (test/equal ""
    1984                (html->shtml "<xmp>a<b>c</foo:xmp>d")
    1985                `(,shtml-top-symbol (xmp "a<b>c") "d"))
    1986    (test/equal ""
    1987                (html->shtml "<foo:xmp>a<b>c</xmp>d")
    1988                `(,shtml-top-symbol (xmp "a<b>c") "d"))
    1989    (test/equal ""
    1990                (html->shtml "<foo:xmp>a<b>c</foo:xmp>d")
    1991                `(,shtml-top-symbol (xmp "a<b>c") "d"))
    1992    (test/equal ""
    1993                (html->shtml "<foo:xmp>a<b>c</bar:xmp>d")
    1994                `(,shtml-top-symbol (xmp "a<b>c") "d"))
    1995 
    1996    (test/equal ""
    1997                (html->shtml "<xmp>a</b>c</xmp>d")
    1998                `(,shtml-top-symbol (xmp "a</b>c")     "d"))
    1999    (test/equal ""
    2000                (html->shtml "<xmp>a</b >c</xmp>d")
    2001                `(,shtml-top-symbol (xmp "a</b >c")    "d"))
    2002    (test/equal ""
    2003                (html->shtml "<xmp>a</ b>c</xmp>d")
    2004                `(,shtml-top-symbol (xmp "a</ b>c")    "d"))
    2005    (test/equal ""
    2006                (html->shtml "<xmp>a</ b >c</xmp>d")
    2007                `(,shtml-top-symbol (xmp "a</ b >c")   "d"))
    2008    (test/equal ""
    2009                (html->shtml "<xmp>a</b:x>c</xmp>d")
    2010                `(,shtml-top-symbol (xmp "a</b:x>c")   "d"))
    2011    (test/equal ""
    2012                (html->shtml "<xmp>a</b::x>c</xmp>d")
    2013                `(,shtml-top-symbol (xmp "a</b::x>c")  "d"))
    2014    (test/equal ""
    2015                (html->shtml "<xmp>a</b:::x>c</xmp>d")
    2016                `(,shtml-top-symbol (xmp "a</b:::x>c") "d"))
    2017    (test/equal ""
    2018                (html->shtml "<xmp>a</b:>c</xmp>d")
    2019                `(,shtml-top-symbol (xmp "a</b:>c")    "d"))
    2020    (test/equal ""
    2021                (html->shtml "<xmp>a</b::>c</xmp>d")
    2022                `(,shtml-top-symbol (xmp "a</b::>c")   "d"))
    2023    (test/equal ""
    2024                (html->shtml "<xmp>a</xmp:b>c</xmp>d")
    2025                `(,shtml-top-symbol (xmp "a</xmp:b>c") "d"))
    2026 
    2027    (test-define "expected output for next two tests"
    2028                 expected
    2029                 `(,shtml-top-symbol (p "real1")
    2030                                     ,lf
    2031                                     (xmp ,lf
    2032                                          ,(string-append "alpha"       lf)
    2033                                          ,(string-append "<P>fake</P>" lf)
    2034                                          ,(string-append "bravo"       lf))
    2035                                     (p "real2")))
    2036 
    2037    (test/equal ""
    2038                (html->shtml (string-append "<P>real1</P>" lf
    2039                                            "<XMP>"        lf
    2040                                            "alpha"        lf
    2041                                            "<P>fake</P>"  lf
    2042                                            "bravo"        lf
    2043                                            "</XMP "       lf
    2044                                            "<P>real2</P>"))
    2045                expected)
    2046 
    2047    (test/equal ""
    2048                (html->shtml (string-append "<P>real1</P>" lf
    2049                                            "<XMP>"        lf
    2050                                            "alpha"        lf
    2051                                            "<P>fake</P>"  lf
    2052                                            "bravo"        lf
    2053                                            "</XMP"        lf
    2054                                            "<P>real2</P>"))
    2055                expected)
    2056 
    2057    (test/equal ""
    2058                (html->shtml "<xmp>a</xmp>x")
    2059                `(,shtml-top-symbol (xmp "a")   "x"))
    2060    (test/equal ""
    2061                (html->shtml (string-append "<xmp>a" lf "</xmp>x"))
    2062                `(,shtml-top-symbol (xmp ,(string-append "a" lf)) "x"))
    2063    (test/equal ""
    2064                (html->shtml "<xmp></xmp>x")
    2065                `(,shtml-top-symbol (xmp)       "x"))
    2066 
    2067    (test/equal ""
    2068                (html->shtml "<xmp>a</xmp") `(,shtml-top-symbol (xmp "a")))
    2069    (test/equal ""
    2070                (html->shtml "<xmp>a</xm")  `(,shtml-top-symbol (xmp "a</xm")))
    2071    (test/equal ""
    2072                (html->shtml "<xmp>a</x")   `(,shtml-top-symbol (xmp "a</x")))
    2073    (test/equal ""
    2074                (html->shtml "<xmp>a</")    `(,shtml-top-symbol (xmp "a</")))
    2075    (test/equal ""
    2076                (html->shtml "<xmp>a<")     `(,shtml-top-symbol (xmp "a<")))
    2077    (test/equal ""
    2078                (html->shtml "<xmp>a")      `(,shtml-top-symbol (xmp "a")))
    2079    (test/equal ""
    2080                (html->shtml "<xmp>")       `(,shtml-top-symbol (xmp)))
    2081    (test/equal ""
    2082                (html->shtml "<xmp")        `(,shtml-top-symbol (xmp)))
    2083 
    2084    (test/equal ""
    2085                (html->shtml "<xmp x=42 ")
    2086                `(,shtml-top-symbol (xmp (@ (x "42")))))
    2087    (test/equal ""
    2088                (html->shtml "<xmp x= ")   `(,shtml-top-symbol (xmp (@ (x)))))
    2089    (test/equal ""
    2090                (html->shtml "<xmp x ")    `(,shtml-top-symbol (xmp (@ (x)))))
    2091    (test/equal ""
    2092                (html->shtml "<xmp x")     `(,shtml-top-symbol (xmp (@ (x)))))
    2093 
    2094    (test/equal ""
    2095                (html->shtml "<script>xxx")
    2096                `(,shtml-top-symbol (script "xxx")))
    2097    (test/equal ""
    2098                (html->shtml "<script/>xxx")
    2099                `(,shtml-top-symbol (script) "xxx"))
    2100 
    2101    (test/equal ""
    2102                (html->shtml "<html xml:lang=\"en\" lang=\"en\">")
    2103                `(,shtml-top-symbol (html (@ (xml:lang "en") (lang "en")))))
    2104 
    2105    (test/equal ""
    2106                (html->shtml "<a href=/foo.html>")
    2107                `(,shtml-top-symbol (a (@ (href "/foo.html")))))
    2108    (test/equal ""
    2109                (html->shtml "<a href=/>foo.html")
    2110                `(,shtml-top-symbol (a (@ (href "/")) "foo.html")))
    2111 
    2112    ;; TODO: Add verbatim-pair cases with attributes in the end tag.
    2113 
    2114    (test/equal ""
    2115                (shtml->html '(p))            "<p></p>")
    2116    (test/equal ""
    2117                (shtml->html '(p "CONTENT"))  "<p>CONTENT</p>")
    2118    (test/equal ""
    2119                (shtml->html '(br))           "<br />")
    2120    (test/equal ""
    2121                (shtml->html '(br "CONTENT")) "<br />")
    2122 
    2123    (test/equal ""
    2124                (shtml->html `(hr (@ (clear "all"))))
    2125                "<hr clear=\"all\" />")
    2126 
    2127    (test/equal ""
    2128                (shtml->html `(hr (@ (noshade))))
    2129                "<hr noshade />")
    2130    (test/equal ""
    2131                (shtml->html `(hr (@ (noshade #t))))
    2132                "<hr noshade />") ;; TODO: Maybe lose this test.
    2133    (test/equal ""
    2134                (shtml->html `(hr (@ (noshade "noshade"))))
    2135                "<hr noshade=\"noshade\" />")
    2136 
    2137    (test/equal ""
    2138                (shtml->html `(hr (@ (aaa "bbbccc"))))
    2139                "<hr aaa=\"bbbccc\" />")
    2140    (test/equal ""
    2141                (shtml->html `(hr (@ (aaa "bbb'ccc"))))
    2142                "<hr aaa=\"bbb'ccc\" />")
    2143    (test/equal ""
    2144                (shtml->html `(hr (@ (aaa "bbb\"ccc"))))
    2145                "<hr aaa='bbb\"ccc' />")
    2146    (test/equal ""
    2147                (shtml->html `(hr (@ (aaa "bbb\"ccc'ddd"))))
    2148                "<hr aaa=\"bbb&quot;ccc'ddd\" />")
    2149 
    2150    (test/equal "" (shtml->html '(& "copy"))                   "&copy;")
    2151    (test/equal "" (shtml->html '(& "rArr"))                   "&rArr;")
    2152    (test/equal "" (shtml->html `(& ,(string->symbol "rArr"))) "&rArr;")
    2153    (test/equal "" (shtml->html '(& 151))                      "&#151;")
    2154 
    2155    (test/equal ""
    2156                (html->shtml "&copy;")
    2157                `(,shtml-top-symbol (& ,(string->symbol "copy"))))
    2158    (test/equal ""
    2159                (html->shtml "&rArr;")
    2160                `(,shtml-top-symbol (& ,(string->symbol "rArr"))))
    2161    (test/equal ""
    2162                (html->shtml "&#151;")
    2163                `(,shtml-top-symbol
    2164                  (& 151)
    2165                  ;; ,(string (%htmlprag:a2c 151))
    2166                  ))
    2167 
    2168    (test/equal ""
    2169                (html->shtml "&#999;")
    2170                `(,shtml-top-symbol (& 999)))
    2171 
    2172    (test/equal ""
    2173                (shtml->html
    2174                 `(,shtml-pi-symbol xml "version=\"1.0\" encoding=\"UTF-8\""))
    2175                "<?xml version=\"1.0\" encoding=\"UTF-8\"?>")
    2176 
    2177    (test/equal ""
    2178                (shtml->html
    2179                 `(,shtml-decl-symbol
    2180                   ,(string->symbol "DOCTYPE")
    2181                   html
    2182                   ,(string->symbol "PUBLIC")
    2183                   "-//W3C//DTD XHTML 1.0 Strict//EN"
    2184                   "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"))
    2185                (string-append
    2186                 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""
    2187                 " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"))
    2188 
    2189    (test/equal ""
    2190                (shtml-entity-value '(*ENTITY* "shtml-named-char" "rArr"))
    2191                (string->symbol "rArr"))
    2192 
    2193    (test/equal ""
    2194                (shtml-entity-value '(& "rArr"))
    2195                (string->symbol "rArr"))
    2196 
    2197    (test/equal ""
    2198                (shtml-entity-value `(& ,(string->symbol "rArr")))
    2199                (string->symbol "rArr"))
    2200 
    2201    (test/equal ""
    2202                (html->shtml "xxx<![CDATA[abc]]>yyy")
    2203                `(,shtml-top-symbol "xxx" "abc" "yyy"))
    2204 
    2205    (test/equal ""
    2206                (html->shtml "xxx<![CDATA[ab]c]]>yyy")
    2207                `(,shtml-top-symbol "xxx" "ab]c" "yyy"))
    2208 
    2209    (test/equal ""
    2210                (html->shtml "xxx<![CDATA[ab]]c]]>yyy")
    2211                `(,shtml-top-symbol "xxx" "ab]]c" "yyy"))
    2212 
    2213    (test/equal ""
    2214                (html->shtml "xxx<![CDATA[]]]>yyy")
    2215                `(,shtml-top-symbol "xxx" "]" "yyy"))
    2216 
    2217    (test/equal ""
    2218                (html->shtml "xxx<![CDATAyyy")
    2219                `(,shtml-top-symbol "xxx" "<![CDATA" "yyy"))
    2220 
    2221    (test/equal "parent constraints with div"
    2222                (html->shtml "<html><div><p>P1</p><p>P2</p></div><p>P3</p>")
    2223                `(,shtml-top-symbol (html (div (p "P1")
    2224                                               (p "P2"))
    2225                                          (p "P3"))))
    2226 
    2227    (test/equal "we no longer convert character references above 126 to string"
    2228                (html->shtml "&#151;")
    2229                `(,shtml-top-symbol (& 151)))
    2230 
    2231    ;; TODO: Write more test cases for HTML encoding.
    2232 
    2233    ;; TODO: Write test cases for foreign-filter of HTML writing.
    2234 
    2235    ;; TODO: Write test cases for attribute values that aren't simple strings.
    2236 
    2237    ;; TODO: Document this.
    2238    ;;
    2239    ;; (define html-1 "<myelem myattr=\"&\">")
    2240    ;; (define shtml   (html->shtml html-1))
    2241    ;; shtml
    2242    ;; (define html-2 (shtml->html shtml))
    2243    ;; html-2
    2244 
    2245    ))
    22461636
    22471637;;; @unnumberedsec History
    … …  
    23941784;;;
    23951785;;; @end table
     1786
     1787)

  • release/4/htmlprag/htmlprag.setup

    r4599 r12119  
    1 (compile -s -R syntax-case -O2 -d1 htmlprag.scm -check-imports -emit-exports htmlprag.exports)
     1(compile -s -O2 -d1 htmlprag.scm -j htmlprag)
     2(compile -s -O2 -d1 htmlprag.import.scm)
     3(compile -c -O2 -d1 htmlprag.scm)
    24
    35(install-extension 'htmlprag
    4                    "htmlprag.so"
    5                    '((documentation "htmlprag.html")
    6                      (version 0.16)
    7                      (exports "htmlprag.exports") ))
    8 
    9 
     6                   '("htmlprag.so" "htmlprag.o" "htmlprag.import.so")
     7                   '((version "0.16.1")
     8                     (static "htmlprag.o")))
Note: See TracChangeset for help on using the changeset viewer.