aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Diff.hs76
-rw-r--r--tests/RunTests.hs115
-rwxr-xr-xtests/generate.sh15
-rw-r--r--tests/runtests.pl110
-rw-r--r--tests/writer.context200
-rw-r--r--tests/writer.docbook129
-rw-r--r--tests/writer.latex178
7 files changed, 533 insertions, 290 deletions
diff --git a/tests/Diff.hs b/tests/Diff.hs
new file mode 100644
index 000000000..f7e562ee2
--- /dev/null
+++ b/tests/Diff.hs
@@ -0,0 +1,76 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Algorithm.Diff
+-- Copyright : (c) Sterling Clover 2008
+-- License : BSD 3 Clause
+-- Maintainer : s.clover@gmail.com
+-- Stability : experimental
+-- Portability : portable
+--
+-- This is an implementation of the O(ND) diff algorithm as described in
+-- \"An O(ND) Difference Algorithm and Its Variations (1986)\"
+-- <http://citeseer.ist.psu.edu/myers86ond.html>. It is O(mn) in space.
+-- The algorithm is the same one used by standared Unix diff.
+-- The assumption is that users of this library will want to diff over
+-- interesting things or peform interesting tasks with the results
+-- (given that, otherwise, they would simply use the standard Unix diff
+-- utility). Thus no attempt is made to present a fancier API to aid
+-- in doing standard and uninteresting things with the results.
+-----------------------------------------------------------------------------
+
+module Diff (DI(..), getDiff, getGroupedDiff) where
+import Data.Array
+import Data.List
+
+-- | Difference Indicator. A value is either from the First list, the Second
+-- or from Both.
+data DI = F | S | B deriving (Show, Eq)
+
+data DL = DL {poi::Int, poj::Int, path::[DI]} deriving (Show, Eq)
+
+instance Ord DL where x <= y = poi x <= poi y
+
+canDiag :: (Eq a) => [a] -> [a] -> Int -> Int -> (Int, Int) -> Bool
+canDiag as bs lena lenb = \(i,j) ->
+ if i < lena && j < lenb then arAs ! i == arBs ! j else False
+ where arAs = listArray (0,lena - 1) as
+ arBs = listArray (0,lenb - 1) bs
+
+chunk :: Int -> [a] -> [[a]]
+chunk x = unfoldr (\a -> case splitAt x a of ([],[]) -> Nothing; a' -> Just a')
+
+dstep :: ((Int,Int)->Bool) -> [DL] -> [DL]
+dstep cd dls = map maximum $ [hd]:(chunk 2 rst)
+ where (hd:rst) = concatMap extend dls
+ extend dl = let pdl = path dl
+ in [addsnake cd $ dl {poi=poi dl + 1, path=(F : pdl)},
+ addsnake cd $ dl {poj=poj dl + 1, path=(S : pdl)}]
+
+addsnake :: ((Int,Int)->Bool) -> DL -> DL
+addsnake cd dl
+ | cd (pi, pj) = addsnake cd $
+ dl {poi = pi + 1, poj = pj + 1, path=(B : path dl)}
+ | otherwise = dl
+ where pi = poi dl; pj = poj dl
+
+lcs :: (Eq a) => [a] -> [a] -> [DI]
+lcs as bs = path . head . dropWhile (\dl -> poi dl /= lena || poj dl /= lenb) .
+ concat . iterate (dstep cd) . (:[]) . addsnake cd $
+ DL {poi=0,poj=0,path=[]}
+ where cd = canDiag as bs lena lenb
+ lena = length as; lenb = length bs
+
+-- | Takes two lists and returns a list indicating the differences
+-- between them.
+getDiff :: (Eq t) => [t] -> [t] -> [(DI, t)]
+getDiff a b = markup a b . reverse $ lcs a b
+ where markup (x:xs) ys (F:ds) = (F, x) : markup xs ys ds
+ markup xs (y:ys) (S:ds) = (S, y) : markup xs ys ds
+ markup (x:xs) (_:ys) (B:ds) = (B, x) : markup xs ys ds
+ markup _ _ _ = []
+
+-- | Takes two lists and returns a list indicating the differences
+-- between them, grouped into chunks.
+getGroupedDiff :: (Eq t) => [t] -> [t] -> [(DI, [t])]
+getGroupedDiff a b = map go . groupBy (\x y -> fst x == fst y) $ getDiff a b
+ where go ((d,x) : xs) = (d, x : map snd xs)
diff --git a/tests/RunTests.hs b/tests/RunTests.hs
new file mode 100644
index 000000000..69f008ac2
--- /dev/null
+++ b/tests/RunTests.hs
@@ -0,0 +1,115 @@
+{-# OPTIONS_GHC -Wall #-}
+-- RunTests.hs - run test suite for pandoc
+-- This script is designed to be run from the tests directory.
+-- It assumes the pandoc executable is in dist/build/pandoc.
+
+module Main where
+import System.Exit
+import System.IO.UTF8
+import System.IO ( openTempFile, stderr )
+import Prelude hiding ( putStrLn, putStr, readFile )
+import System.Process ( runProcess, waitForProcess )
+import System.FilePath ( (</>), (<.>) )
+import System.Directory
+import System.Exit
+import Text.Printf
+import Diff
+
+pandocPath :: FilePath
+pandocPath = ".." </> "dist" </> "build" </> "pandoc" </> "pandoc"
+
+data TestResult = TestPassed
+ | TestError ExitCode
+ | TestFailed [(DI, String)]
+ deriving (Eq)
+
+instance Show TestResult where
+ show TestPassed = "PASSED"
+ show (TestError ec) = "ERROR " ++ show ec
+ show (TestFailed d) = "FAILED\n" ++ showDiff d
+
+showDiff :: [(DI, String)] -> String
+showDiff [] = ""
+showDiff ((F, ln) : ds) = "|TEST| " ++ ln ++ "\n" ++ showDiff ds
+showDiff ((S, ln) : ds) = "|NORM| " ++ ln ++ "\n" ++ showDiff ds
+showDiff ((B, _ ) : ds) = showDiff ds
+
+writerFormats :: [String]
+writerFormats = [ "native"
+ , "html"
+ , "docbook"
+ , "opendocument"
+ , "latex"
+ , "context"
+ , "texinfo"
+ , "man"
+ , "markdown"
+ , "rst"
+ , "mediawiki"
+ , "rtf"
+ ]
+
+main :: IO ()
+main = do
+ r1s <- mapM runWriterTest writerFormats
+ r2 <- runS5WriterTest "basic" ["-s"] "s5"
+ r3 <- runS5WriterTest "fancy" ["-s","-m","-i"] "s5"
+ r4 <- runS5WriterTest "fragment" [] "html"
+ r5 <- runS5WriterTest "inserts" ["-s", "-H", "insert",
+ "-B", "insert", "-A", "insert", "-c", "main.css"] "html"
+ r6 <- runTest "markdown reader" ["-r", "markdown", "-w", "native", "-s", "-S"]
+ "testsuite.txt" "testsuite.native"
+ r7 <- runTest "markdown reader (tables)" ["-r", "markdown", "-w", "native"]
+ "tables.txt" "tables.native"
+ r8 <- runTest "rst reader" ["-r", "rst", "-w", "native", "-s", "-S"]
+ "rst-reader.rst" "rst-reader.native"
+ r9 <- runTest "html reader" ["-r", "html", "-w", "native", "-s"]
+ "html-reader.html" "html-reader.native"
+ r10 <- runTest "latex reader" ["-r", "latex", "-w", "native", "-s", "-R"]
+ "latex-reader.latex" "latex-reader.native"
+ r11 <- runTest "native reader" ["-r", "native", "-w", "native", "-s"]
+ "testsuite.native" "testsuite.native"
+ let results = r1s ++ [r2, r3, r4, r5, r6, r7, r8, r9, r10, r11]
+ if all id results
+ then do
+ putStrLn "\nAll tests passed."
+ exitWith ExitSuccess
+ else do
+ let failures = length $ filter not results
+ putStrLn $ "\n" ++ show failures ++ " tests failed."
+ exitWith (ExitFailure failures)
+
+runWriterTest :: String -> IO Bool
+runWriterTest format = do
+ r1 <- runTest (format ++ " writer") ["-r", "native", "-s", "-w", format] "testsuite.native" ("writer" <.> format)
+ r2 <- runTest (format ++ " writer (tables)") ["-r", "native", "-w", format] "tables.native" ("tables" <.> format)
+ return (r1 && r2)
+
+runS5WriterTest :: String -> [String] -> String -> IO Bool
+runS5WriterTest modifier opts format = runTest (format ++ " writer (" ++ modifier ++ ")")
+ (["-r", "native", "-w", format] ++ opts) "s5.native" ("s5." ++ modifier <.> "html")
+
+-- | Run a test, return True if test passed.
+runTest :: String -- ^ Title of test
+ -> [String] -- ^ Options to pass to pandoc
+ -> String -- ^ Input filepath
+ -> FilePath -- ^ Norm (for test results) filepath
+ -> IO Bool
+runTest testname opts inp norm = do
+ (outputPath, hOut) <- openTempFile "" "pandoc-test"
+ let inpPath = inp
+ let normPath = norm
+ -- Note: COLUMNS must be set for markdown table reader
+ ph <- runProcess pandocPath (opts ++ [inpPath]) Nothing (Just [("COLUMNS", "80")]) Nothing (Just hOut) (Just stderr)
+ ec <- waitForProcess ph
+ result <- if ec == ExitSuccess
+ then do
+ outputContents <- readFile outputPath
+ normContents <- readFile normPath
+ if outputContents == normContents
+ then return TestPassed
+ else return $ TestFailed $ getDiff (lines outputContents) (lines normContents)
+ else return $ TestError ec
+ removeFile outputPath
+ putStrLn $ printf "%-28s ---> %s" testname (show result)
+ return (result == TestPassed)
diff --git a/tests/generate.sh b/tests/generate.sh
deleted file mode 100755
index 090691f02..000000000
--- a/tests/generate.sh
+++ /dev/null
@@ -1,15 +0,0 @@
-#!/bin/sh
-
-../pandoc -r native -s -w native testsuite.native > writer.native
-../pandoc -r native -s -w markdown testsuite.native > writer.markdown
-../pandoc -r native -s -w rst testsuite.native > writer.rst
-../pandoc -r native -s -w html testsuite.native > writer.html
-../pandoc -r native -s -w latex testsuite.native > writer.latex
-../pandoc -r native -s -w texinfo testsuite.native > writer.texinfo
-../pandoc -r native -s -w rtf testsuite.native > writer.rtf
-../pandoc -r native -s -w man testsuite.native > writer.man
-../pandoc -r native -s -w mediawiki testsuite.native > writer.mediawiki
-../pandoc -r native -s -w opendocument testsuite.native > writer.opendocument
-sed -e '/^, Header 1 \[Str "HTML",Space,Str "Blocks"\]/,/^, HorizontalRule/d' testsuite.native | ../pandoc -r native -w docbook -s > writer.docbook
-sed -e '/^, Header 1 \[Str "LaTeX"\]/,/^, HorizontalRule/d' testsuite.native | ../pandoc -r native -w context -s > writer.context
-
diff --git a/tests/runtests.pl b/tests/runtests.pl
deleted file mode 100644
index c7573b3fb..000000000
--- a/tests/runtests.pl
+++ /dev/null
@@ -1,110 +0,0 @@
-#!/bin/perl -w
-
-$verbose = 1;
-my $diffexists = `which diff`;
-if ($diffexists eq "") { die "diff not found in path.\n"; }
-
-my $script = "COLUMNS=78 ./pandoc";
-
-use Getopt::Long;
-GetOptions("script=s" => \$script);
-
-unless (-f $script) { die "$script does not exist.\n"; }
-unless (-x $script) { die "$script is not executable.\n"; }
-
-print "Writer tests:\n";
-
-my @writeformats = ("html", "latex", "texinfo", "rst", "rtf", "markdown", "mediawiki", "opendocument", "man", "native"); # docbook, context, and s5 handled separately
-my $source = "testsuite.native";
-
-sub test_results
-{
- my $testname = $_[0];
- my $output = $_[1];
- my $norm = $_[2];
- my $diffoutput = `diff --strip-trailing-cr $output $norm`;
- if ($diffoutput eq "")
- {
- print "passed\n";
- }
- else
- {
- print "FAILED\n";
- if ($verbose) { print $diffoutput; }
- }
-}
-
-foreach my $format (@writeformats)
-{
- $options = "";
-
- my $extension = $format;
- print "Testing $format writer...";
-
- `$script -r native -w $extension $options -s $source > tmp.$extension`;
-
- test_results("$format writer", "tmp.$extension", "writer.$format");
-
- print " $format tables...";
-
- `$script -r native -w $extension tables.native > tmp.$extension`;
-
- test_results("$format writer", "tmp.$extension", "tables.$format");
-}
-
-print "Testing docbook writer...";
-# remove HTML block tests, as this produces invalid docbook...
-`sed -e '/^, Header 1 \\[Str "HTML",Space,Str "Blocks"\\]/,/^, HorizontalRule/d' testsuite.native | $script -r native -w docbook -s > tmp.docbook`;
-test_results("docbook writer", "tmp.docbook", "writer.docbook");
-`$script -r native -w docbook tables.native > tmp.docbook`;
-print " docbook tables...";
-test_results("docbook tables", "tmp.docbook", "tables.docbook");
-
-print "Testing context writer...";
-# remove LaTeX tests, as this produces invalid docbook...
-`sed -e '/^, Header 1 \\[Str "LaTeX"\\]/,/^, HorizontalRule/d' testsuite.native | $script -r native -w context -s > tmp.context`;
-test_results("context writer", "tmp.context", "writer.context");
-`$script -r native -w context tables.native > tmp.context`;
-print " context tables...";
-test_results("context tables", "tmp.context", "tables.context");
-
-print "Testing s5 writer (basic)...";
-`$script -r native -w s5 -s s5.native > tmp.html`;
-test_results("s5 writer (basic)", "tmp.html", "s5.basic.html");
-
-print "Testing s5 writer (fancy)...";
-`$script -r native -w s5 -s -m -i s5.native > tmp.html`;
-test_results("s5 writer (fancy)", "tmp.html", "s5.fancy.html");
-
-print "Testing html fragment...";
-`$script -r native -w html s5.native > tmp.html`;
-test_results("html fragment", "tmp.html", "s5.fragment.html");
-
-print "Testing -H -B -A -c options...";
-`$script -r native -s -w html -H insert -B insert -A insert -c main.css s5.native > tmp.html`;
-test_results("-B, -A, -H, -c options", "tmp.html", "s5.inserts.html");
-
-print "\nReader tests:\n";
-
-print "Testing markdown reader...";
-`$script -r markdown -w native -s -S testsuite.txt > tmp.native`;
-test_results("markdown reader", "tmp.native", "testsuite.native");
-
-print "Testing rst reader...";
-`$script -r rst -w native -s rst-reader.rst > tmp.native`;
-test_results("rst reader", "tmp.native", "rst-reader.native");
-
-print "Testing html reader...";
-`$script -r html -w native -s html-reader.html > tmp.native`;
-test_results("html reader", "tmp.native", "html-reader.native");
-
-print "Testing latex reader...";
-`$script -r latex -w native -R -s latex-reader.latex > tmp.native`;
-test_results("latex reader", "tmp.native", "latex-reader.native");
-
-print "Testing native reader...";
-`$script -r native -w native -s testsuite.native > tmp.native`;
-test_results("native reader", "tmp.native", "testsuite.native");
-
-`rm tmp.*`;
-
diff --git a/tests/writer.context b/tests/writer.context
index e13a906dd..de0f36590 100644
--- a/tests/writer.context
+++ b/tests/writer.context
@@ -139,9 +139,9 @@ sub status {
A list:
\startitemize[n][stopper=.]
-\item
+\item
item one
-\item
+\item
item two
\stopitemize
@@ -193,66 +193,66 @@ These should not be escaped: \$ \\ \> \[ \{
Asterisks tight:
\startitemize
-\item
+\item
asterisk 1
-\item
+\item
asterisk 2
-\item
+\item
asterisk 3
\stopitemize
Asterisks loose:
\startitemize
-\item
+\item
asterisk 1
-\item
+\item
asterisk 2
-\item
+\item
asterisk 3
\stopitemize
Pluses tight:
\startitemize
-\item
+\item
Plus 1
-\item
+\item
Plus 2
-\item
+\item
Plus 3
\stopitemize
Pluses loose:
\startitemize
-\item
+\item
Plus 1
-\item
+\item
Plus 2
-\item
+\item
Plus 3
\stopitemize
Minuses tight:
\startitemize
-\item
+\item
Minus 1
-\item
+\item
Minus 2
-\item
+\item
Minus 3
\stopitemize
Minuses loose:
\startitemize
-\item
+\item
Minus 1
-\item
+\item
Minus 2
-\item
+\item
Minus 3
\stopitemize
@@ -261,71 +261,71 @@ Minuses loose:
Tight:
\startitemize[n][stopper=.]
-\item
+\item
First
-\item
+\item
Second
-\item
+\item
Third
\stopitemize
and:
\startitemize[n][stopper=.]
-\item
+\item
One
-\item
+\item
Two
-\item
+\item
Three
\stopitemize
Loose using tabs:
\startitemize[n][stopper=.]
-\item
+\item
First
-\item
+\item
Second
-\item
+\item
Third
\stopitemize
and using spaces:
\startitemize[n][stopper=.]
-\item
+\item
One
-\item
+\item
Two
-\item
+\item
Three
\stopitemize
Multiple paragraphs:
\startitemize[n][stopper=.]
-\item
+\item
Item 1, graf one.
Item 1. graf two. The quick brown fox jumped over the lazy dog's
back.
-\item
+\item
Item 2.
-\item
+\item
Item 3.
\stopitemize
\subsubject{Nested}
\startitemize
-\item
+\item
Tab
\startitemize
- \item
+ \item
Tab
\startitemize
- \item
+ \item
Tab
\stopitemize
\stopitemize
@@ -334,54 +334,54 @@ Multiple paragraphs:
Here's another:
\startitemize[n][stopper=.]
-\item
+\item
First
-\item
+\item
Second:
\startitemize
- \item
+ \item
Fee
- \item
+ \item
Fie
- \item
+ \item
Foe
\stopitemize
-\item
+\item
Third
\stopitemize
Same thing but with paragraphs:
\startitemize[n][stopper=.]
-\item
+\item
First
-\item
+\item
Second:
\startitemize
- \item
+ \item
Fee
- \item
+ \item
Fie
- \item
+ \item
Foe
\stopitemize
-\item
+\item
Third
\stopitemize
\subsubject{Tabs and spaces}
\startitemize
-\item
+\item
this is a list item indented with tabs
-\item
+\item
this is a list item indented with spaces
\startitemize
- \item
+ \item
this is an example list item indented with tabs
- \item
+ \item
this is an example list item indented with spaces
\stopitemize
\stopitemize
@@ -389,22 +389,22 @@ Same thing but with paragraphs:
\subsubject{Fancy list markers}
\startitemize[n][start=2,left=(,stopper=),width=2.0em]
-\item
+\item
begins with 2
-\item
+\item
and now 3
with a continuation
\startitemize[r][start=4,stopper=.,width=2.0em]
- \item
+ \item
sublist with roman numerals, starting with 4
- \item
+ \item
more items
\startitemize[A][left=(,stopper=),width=2.0em]
- \item
+ \item
a subsublist
- \item
+ \item
a subsublist
\stopitemize
\stopitemize
@@ -413,16 +413,16 @@ Same thing but with paragraphs:
Nesting:
\startitemize[A][stopper=.]
-\item
+\item
Upper Alpha
\startitemize[R][stopper=.]
- \item
+ \item
Upper Roman.
\startitemize[n][start=6,left=(,stopper=),width=2.0em]
- \item
+ \item
Decimal start with 6
\startitemize[a][start=3,stopper=)]
- \item
+ \item
Lower alpha with paren
\stopitemize
\stopitemize
@@ -432,12 +432,12 @@ Nesting:
Autonumbering:
\startitemize[n]
-\item
+\item
Autonumber.
-\item
+\item
More.
\startitemize[a]
- \item
+ \item
Nested.
\stopitemize
\stopitemize
@@ -624,20 +624,68 @@ Ellipses\ldots{}and\ldots{}and\ldots{}.
\thinrule
+\subject{LaTeX}
+
+\startitemize
+\item
+ \cite[22-23]{smith.1899}
+\item
+ \doublespacing
+\item
+ $2+2=4$
+\item
+ $x \in y$
+\item
+ $\alpha \wedge \omega$
+\item
+ $223$
+\item
+ $p$-Tree
+\item
+ $\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$
+\item
+ Here's one that has a line break in it:
+ $\alpha + \omega \times x^2$.
+\stopitemize
+
+These shouldn't be math:
+
+\startitemize
+\item
+ To get the famous equation, write \type{$e = mc^2$}.
+\item
+ \$22,000 is a {\em lot} of money. So is \$34,000. (It worked if
+ \quotation{lot} is emphasized.)
+\item
+ Shoes (\$20) and socks (\$5).
+\item
+ Escaped \type{$}: \$73 {\em this should be emphasized} 23\$.
+\stopitemize
+
+Here's a LaTeX table:
+
+\begin{tabular}{|l|l|}\hline
+Animal & Number \\ \hline
+Dog & 2 \\
+Cat & 1 \\ \hline
+\end{tabular}
+
+\thinrule
+
\subject{Special Characters}
Here is some unicode:
\startitemize
-\item
+\item
I hat: Î
-\item
+\item
o umlaut: ö
-\item
+\item
section: §
-\item
+\item
set membership: ∈
-\item
+\item
copyright: ©
\stopitemize
@@ -754,11 +802,11 @@ With an ampersand:
\useURL[27][http://example.com/?foo=1&bar=2][][http://example.com/?foo=1\&bar=2]\from[27]
\startitemize
-\item
+\item
In a list?
-\item
+\item
\useURL[28][http://example.com/][][http://example.com/]\from[28]
-\item
+\item
It should.
\stopitemize
@@ -826,7 +874,7 @@ Notes can go in quotes.
\stopblockquote
\startitemize[n][stopper=.]
-\item
+\item
And in list items.
\footnote{In list.}
\stopitemize
diff --git a/tests/writer.docbook b/tests/writer.docbook
index 424141cc9..d2bcac18d 100644
--- a/tests/writer.docbook
+++ b/tests/writer.docbook
@@ -758,6 +758,135 @@ These should not be escaped: \$ \\ \&gt; \[ \{
</variablelist>
</section>
<section>
+ <title>HTML Blocks</title>
+ <para>
+ Simple block on one line:
+ </para>
+ <div>
+ foo
+ </div>
+
+ <para>
+ And nested without indentation:
+ </para>
+ <div>
+<div>
+<div>
+ foo
+ </div>
+</div>
+<div>
+ bar
+ </div>
+</div>
+
+ <para>
+ Interpreted markdown in a table:
+ </para>
+ <table>
+<tr>
+<td>
+ This is <emphasis>emphasized</emphasis>
+ </td>
+<td>
+ And this is <emphasis role="strong">strong</emphasis>
+ </td>
+</tr>
+</table>
+
+<script type="text/javascript">document.write('This *should not* be interpreted as markdown');</script>
+
+ <para>
+ Here's a simple block:
+ </para>
+ <div>
+
+ foo
+ </div>
+
+ <para>
+ This should be a code block, though:
+ </para>
+ <screen>
+&lt;div&gt;
+ foo
+&lt;/div&gt;
+</screen>
+ <para>
+ As should this:
+ </para>
+ <screen>
+&lt;div&gt;foo&lt;/div&gt;
+</screen>
+ <para>
+ Now, nested:
+ </para>
+ <div>
+ <div>
+ <div>
+
+ foo
+ </div>
+ </div>
+</div>
+
+ <para>
+ This should just be an HTML comment:
+ </para>
+ <!-- Comment -->
+
+ <para>
+ Multiline:
+ </para>
+ <!--
+Blah
+Blah
+-->
+
+<!--
+ This is another comment.
+-->
+
+ <para>
+ Code block:
+ </para>
+ <screen>
+&lt;!-- Comment --&gt;
+</screen>
+ <para>
+ Just plain comment, with trailing spaces on the line:
+ </para>
+ <!-- foo -->
+
+ <para>
+ Code:
+ </para>
+ <screen>
+&lt;hr /&gt;
+</screen>
+ <para>
+ Hr's:
+ </para>
+ <hr>
+
+<hr />
+
+<hr />
+
+<hr>
+
+<hr />
+
+<hr />
+
+<hr class="foo" id="bar" />
+
+<hr class="foo" id="bar" />
+
+<hr class="foo" id="bar">
+
+ </section>
+ <section>
<title>Inline Markup</title>
<para>
This is <emphasis>emphasized</emphasis>, and so
diff --git a/tests/writer.latex b/tests/writer.latex
index b4547b7db..70e50645e 100644
--- a/tests/writer.latex
+++ b/tests/writer.latex
@@ -83,9 +83,9 @@ sub status {
A list:
\begin{enumerate}[1.]
-\item
+\item
item one
-\item
+\item
item two
\end{enumerate}
Nested block quotes:
@@ -134,69 +134,69 @@ These should not be escaped: \$ \\ \> \[ \{
Asterisks tight:
\begin{itemize}
-\item
+\item
asterisk 1
-\item
+\item
asterisk 2
-\item
+\item
asterisk 3
\end{itemize}
Asterisks loose:
\begin{itemize}
-\item
+\item
asterisk 1
-\item
+\item
asterisk 2
-\item
+\item
asterisk 3
\end{itemize}
Pluses tight:
\begin{itemize}
-\item
+\item
Plus 1
-\item
+\item
Plus 2
-\item
+\item
Plus 3
\end{itemize}
Pluses loose:
\begin{itemize}
-\item
+\item
Plus 1
-\item
+\item
Plus 2
-\item
+\item
Plus 3
\end{itemize}
Minuses tight:
\begin{itemize}
-\item
+\item
Minus 1
-\item
+\item
Minus 2
-\item
+\item
Minus 3
\end{itemize}
Minuses loose:
\begin{itemize}
-\item
+\item
Minus 1
-\item
+\item
Minus 2
-\item
+\item
Minus 3
\end{itemize}
@@ -205,75 +205,75 @@ Minuses loose:
Tight:
\begin{enumerate}[1.]
-\item
+\item
First
-\item
+\item
Second
-\item
+\item
Third
\end{enumerate}
and:
\begin{enumerate}[1.]
-\item
+\item
One
-\item
+\item
Two
-\item
+\item
Three
\end{enumerate}
Loose using tabs:
\begin{enumerate}[1.]
-\item
+\item
First
-\item
+\item
Second
-\item
+\item
Third
\end{enumerate}
and using spaces:
\begin{enumerate}[1.]
-\item
+\item
One
-\item
+\item
Two
-\item
+\item
Three
\end{enumerate}
Multiple paragraphs:
\begin{enumerate}[1.]
-\item
+\item
Item 1, graf one.
Item 1. graf two. The quick brown fox jumped over the lazy dog's
back.
-\item
+\item
Item 2.
-\item
+\item
Item 3.
\end{enumerate}
\subsection{Nested}
\begin{itemize}
-\item
+\item
Tab
\begin{itemize}
- \item
+ \item
Tab
\begin{itemize}
- \item
+ \item
Tab
\end{itemize}
\end{itemize}
@@ -281,56 +281,56 @@ Multiple paragraphs:
Here's another:
\begin{enumerate}[1.]
-\item
+\item
First
-\item
+\item
Second:
\begin{itemize}
- \item
+ \item
Fee
- \item
+ \item
Fie
- \item
+ \item
Foe
\end{itemize}
-\item
+\item
Third
\end{enumerate}
Same thing but with paragraphs:
\begin{enumerate}[1.]
-\item
+\item
First
-\item
+\item
Second:
\begin{itemize}
- \item
+ \item
Fee
- \item
+ \item
Fie
- \item
+ \item
Foe
\end{itemize}
-\item
+\item
Third
\end{enumerate}
\subsection{Tabs and spaces}
\begin{itemize}
-\item
+\item
this is a list item indented with tabs
-\item
+\item
this is a list item indented with spaces
\begin{itemize}
- \item
+ \item
this is an example list item indented with tabs
- \item
+ \item
this is an example list item indented with spaces
\end{itemize}
@@ -339,23 +339,23 @@ Same thing but with paragraphs:
\begin{enumerate}[(1)]
\setcounter{enumi}{1}
-\item
+\item
begins with 2
-\item
+\item
and now 3
with a continuation
\begin{enumerate}[i.]
\setcounter{enumii}{3}
- \item
+ \item
sublist with roman numerals, starting with 4
- \item
+ \item
more items
\begin{enumerate}[(A)]
- \item
+ \item
a subsublist
- \item
+ \item
a subsublist
\end{enumerate}
\end{enumerate}
@@ -363,18 +363,18 @@ Same thing but with paragraphs:
Nesting:
\begin{enumerate}[A.]
-\item
+\item
Upper Alpha
\begin{enumerate}[I.]
- \item
+ \item
Upper Roman.
\begin{enumerate}[(1)]
\setcounter{enumiii}{5}
- \item
+ \item
Decimal start with 6
\begin{enumerate}[a)]
\setcounter{enumiv}{2}
- \item
+ \item
Lower alpha with paren
\end{enumerate}
\end{enumerate}
@@ -383,12 +383,12 @@ Nesting:
Autonumbering:
\begin{enumerate}
-\item
+\item
Autonumber.
-\item
+\item
More.
\begin{enumerate}
- \item
+ \item
Nested.
\end{enumerate}
\end{enumerate}
@@ -562,37 +562,37 @@ Ellipses\ldots{}and\ldots{}and\ldots{}.
\section{LaTeX}
\begin{itemize}
-\item
+\item
\cite[22-23]{smith.1899}
-\item
+\item
\doublespacing
-\item
+\item
$2+2=4$
-\item
+\item
$x \in y$
-\item
+\item
$\alpha \wedge \omega$
-\item
+\item
$223$
-\item
+\item
$p$-Tree
-\item
+\item
$\frac{d}{dx}f(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}$
-\item
+\item
Here's one that has a line break in it:
$\alpha + \omega \times x^2$.
\end{itemize}
These shouldn't be math:
\begin{itemize}
-\item
+\item
To get the famous equation, write \verb!$e = mc^2$!.
-\item
+\item
\$22,000 is a \emph{lot} of money. So is \$34,000. (It worked if
``lot'' is emphasized.)
-\item
+\item
Shoes (\$20) and socks (\$5).
-\item
+\item
Escaped \verb!$!: \$73 \emph{this should be emphasized} 23\$.
\end{itemize}
Here's a LaTeX table:
@@ -610,15 +610,15 @@ Cat & 1 \\ \hline
Here is some unicode:
\begin{itemize}
-\item
+\item
I hat: Î
-\item
+\item
o umlaut: ö
-\item
+\item
section: §
-\item
+\item
set membership: ∈
-\item
+\item
copyright: ©
\end{itemize}
AT\&T has an ampersand in their name.
@@ -732,11 +732,11 @@ Here's an
With an ampersand: \url{http://example.com/?foo=1&bar=2}
\begin{itemize}
-\item
+\item
In a list?
-\item
+\item
\url{http://example.com/}
-\item
+\item
It should.
\end{itemize}
An e-mail address:
@@ -791,7 +791,7 @@ Notes can go in quotes.%
\end{quote}
\begin{enumerate}[1.]
-\item
+\item
And in list items.%
\footnote{In list.}
\end{enumerate}