diff options
27 files changed, 120 insertions, 127 deletions
diff --git a/test/Tests/Writers/Docx.hs b/test/Tests/Writers/Docx.hs index 1537ea85d..57e55e354 100644 --- a/test/Tests/Writers/Docx.hs +++ b/test/Tests/Writers/Docx.hs @@ -1,161 +1,147 @@ module Tests.Writers.Docx (tests) where -import qualified Data.ByteString as BS -import System.FilePath ((</>)) -import System.IO.Unsafe (unsafePerformIO) +import Text.Pandoc import Test.Tasty -import Tests.Helpers -import Text.Pandoc.Class (runIOorExplode, setUserDataDir) -import Text.Pandoc.Definition -import Text.Pandoc.Options -import Text.Pandoc.Readers.Docx -import Text.Pandoc.Readers.Native -import qualified Text.Pandoc.UTF8 as UTF8 -import Text.Pandoc.Walk -import Text.Pandoc.Writers.Docx +import Tests.Writers.OOXML +import Test.Tasty.HUnit +import Data.List (isPrefixOf) -type Options = (WriterOptions, ReaderOptions) - -compareOutput :: Options - -> FilePath - -> FilePath - -> IO (Pandoc, Pandoc) -compareOutput (wopts, ropts) nativeFileIn nativeFileOut = do - nf <- UTF8.toText <$> BS.readFile nativeFileIn - nf' <- UTF8.toText <$> BS.readFile nativeFileOut - runIOorExplode $ do - setUserDataDir $ Just (".." </> "data") - roundtripped <- readNative def nf >>= - writeDocx wopts >>= readDocx ropts - orig <- readNative def nf' - return (walk fixImages roundtripped, walk fixImages orig) - --- make all image filenames "image", since otherwise round-trip --- tests fail because of different behavior of Data.Unique in --- different ghc versions... -fixImages :: Inline -> Inline -fixImages (Image attr alt (_,tit)) = Image attr alt ("image",tit) -fixImages x = x - -testCompareWithOptsIO :: Options -> String -> FilePath -> FilePath -> IO TestTree -testCompareWithOptsIO opts name nativeFileIn nativeFileOut = do - (dp, np) <- compareOutput opts nativeFileIn nativeFileOut - return $ test id name (dp, np) - -testCompareWithOpts :: Options -> String -> FilePath -> FilePath -> TestTree -testCompareWithOpts opts name nativeFileIn nativeFileOut = - unsafePerformIO $ testCompareWithOptsIO opts name nativeFileIn nativeFileOut - -roundTripCompareWithOpts :: Options -> String -> FilePath -> TestTree -roundTripCompareWithOpts opts name nativeFile = - testCompareWithOpts opts name nativeFile nativeFile - --- testCompare :: String -> FilePath -> FilePath -> TestTree --- testCompare = testCompareWithOpts def - -roundTripCompare :: String -> FilePath -> TestTree -roundTripCompare = roundTripCompareWithOpts def +-- we add an extra check to make sure that we're not writing in the +-- toplevel docx directory. We don't want to accidentally overwrite an +-- Word-generated docx file used to test the reader. +docxTest :: String -> WriterOptions -> FilePath -> FilePath -> TestTree +docxTest testName opts nativeFP goldenFP = + if "docx/golden/" `isPrefixOf` goldenFP + then ooxmlTest writeDocx testName opts nativeFP goldenFP + else testCase testName $ + assertFailure $ + goldenFP ++ " is not in `test/docx/golden`" tests :: [TestTree] tests = [ testGroup "inlines" - [ roundTripCompare + [ docxTest "font formatting" - "docx/inline_formatting_writer.native" - , roundTripCompare - "font formatting with character styles" - "docx/char_styles.native" - , roundTripCompare + def + "docx/inline_formatting.native" + "docx/golden/inline_formatting.docx" + , docxTest "hyperlinks" - "docx/links_writer.native" - , roundTripCompare + def + "docx/links.native" + "docx/golden/links.docx" + , docxTest "inline image" - "docx/image_no_embed_writer.native" - , roundTripCompare - "inline image in links" - "docx/inline_images_writer.native" - , roundTripCompare + def + "docx/image_writer_test.native" + "docx/golden/image.docx" + , docxTest + "inline images" + def + "docx/inline_images_writer_test.native" + "docx/golden/inline_images.docx" + , docxTest "handling unicode input" + def "docx/unicode.native" - , roundTripCompare - "literal tabs" - "docx/tabs.native" - , roundTripCompare - "normalizing inlines" - "docx/normalize.native" - , roundTripCompare - "normalizing inlines deep inside blocks" - "docx/deep_normalize.native" - , roundTripCompare - "move trailing spaces outside of formatting" - "docx/trailing_spaces_in_formatting.native" - , roundTripCompare - "inline code (with VerbatimChar style)" + "docx/golden/unicode.docx" + , docxTest + "inline code" + def "docx/inline_code.native" - , roundTripCompare + "docx/golden/inline_code.docx" + , docxTest "inline code in subscript and superscript" + def "docx/verbatim_subsuper.native" + "docx/golden/verbatim_subsuper.docx" ] , testGroup "blocks" - [ roundTripCompare + [ docxTest "headers" + def "docx/headers.native" - , roundTripCompare - "headers already having auto identifiers" - "docx/already_auto_ident.native" - , roundTripCompare - "numbered headers automatically made into list" - "docx/numbered_header.native" - , roundTripCompare - "i18n blocks (headers and blockquotes)" - "docx/i18n_blocks.native" - -- Continuation does not survive round-trip - , roundTripCompare + "docx/golden/headers.docx" + , docxTest + "nested anchor spans in header" + def + "docx/nested_anchors_in_header.native" + "docx/golden/nested_anchors_in_header.docx" + , docxTest "lists" - "docx/lists_writer.native" - , roundTripCompare + def + "docx/lists.native" + "docx/golden/lists.docx" + , docxTest + "lists continuing after interruption" + def + "docx/lists_continuing.native" + "docx/golden/lists_continuing.docx" + , docxTest + "lists restarting after interruption" + def + "docx/lists_restarting.native" + "docx/golden/lists_restarting.docx" + , docxTest "definition lists" + def "docx/definition_list.native" - , roundTripCompare - "custom defined lists in styles" - "docx/german_styled_lists.native" - , roundTripCompare + "docx/golden/definition_list.docx" + , docxTest "footnotes and endnotes" + def "docx/notes.native" - , roundTripCompare - "blockquotes (parsing indent as blockquote)" + "docx/golden/notes.docx" + , docxTest + "links in footnotes and endnotes" + def + "docx/link_in_notes.native" + "docx/golden/link_in_notes.docx" + , docxTest + "blockquotes" + def "docx/block_quotes_parse_indent.native" - , roundTripCompare - "hanging indents" - "docx/hanging_indent.native" - -- tables headers do not survive round-trip, should look into that - , roundTripCompare + "docx/golden/block_quotes.docx" + , docxTest "tables" + def "docx/tables.native" - , roundTripCompare + "docx/golden/tables.docx" + , docxTest "tables with lists in cells" + def "docx/table_with_list_cell.native" - , roundTripCompare + "docx/golden/table_with_list_cell.docx" + , docxTest + "tables with one row" + def + "docx/table_one_row.native" + "docx/golden/table_one_row.docx" + , docxTest "code block" + def "docx/codeblock.native" - , roundTripCompare - "dropcap paragraphs" - "docx/drop_cap.native" + "docx/golden/codeblock.docx" ] - , testGroup "metadata" - [ roundTripCompareWithOpts (def,def{readerStandalone=True}) - "metadata fields" - "docx/metadata.native" - , roundTripCompareWithOpts (def,def{readerStandalone=True}) - "stop recording metadata with normal text" - "docx/metadata_after_normal.native" + , testGroup "track changes" + [ docxTest + "insertion" + def + "docx/track_changes_insertion_all.native" + "docx/golden/track_changes_insertion.docx" + , docxTest + "deletion" + def + "docx/track_changes_deletion_all.native" + "docx/golden/track_changes_deletion.docx" + , docxTest + "move text" + def + "docx/track_changes_move_all.native" + "docx/golden/track_changes_move.docx" + , docxTest + "comments" + def + "docx/comments.native" + "docx/golden/comments.docx" ] - , testGroup "customized styles" - [ testCompareWithOpts - ( def{writerReferenceDoc=Just "docx/custom-style-reference.docx"} - , def) - "simple customized blocks and inlines" - "docx/custom-style-roundtrip-start.native" - "docx/custom-style-roundtrip-end.native" - ] - ] diff --git a/test/docx/golden/block_quotes.docx b/test/docx/golden/block_quotes.docx Binary files differnew file mode 100644 index 000000000..28d6f035e --- /dev/null +++ b/test/docx/golden/block_quotes.docx diff --git a/test/docx/golden/codeblock.docx b/test/docx/golden/codeblock.docx Binary files differnew file mode 100644 index 000000000..af85598dc --- /dev/null +++ b/test/docx/golden/codeblock.docx diff --git a/test/docx/golden/comments.docx b/test/docx/golden/comments.docx Binary files differnew file mode 100644 index 000000000..33831dc06 --- /dev/null +++ b/test/docx/golden/comments.docx diff --git a/test/docx/golden/definition_list.docx b/test/docx/golden/definition_list.docx Binary files differnew file mode 100644 index 000000000..c3f076387 --- /dev/null +++ b/test/docx/golden/definition_list.docx diff --git a/test/docx/golden/headers.docx b/test/docx/golden/headers.docx Binary files differnew file mode 100644 index 000000000..c2b6206a3 --- /dev/null +++ b/test/docx/golden/headers.docx diff --git a/test/docx/golden/image.docx b/test/docx/golden/image.docx Binary files differnew file mode 100644 index 000000000..dc49f266b --- /dev/null +++ b/test/docx/golden/image.docx diff --git a/test/docx/golden/inline_code.docx b/test/docx/golden/inline_code.docx Binary files differnew file mode 100644 index 000000000..1d415e411 --- /dev/null +++ b/test/docx/golden/inline_code.docx diff --git a/test/docx/golden/inline_formatting.docx b/test/docx/golden/inline_formatting.docx Binary files differnew file mode 100644 index 000000000..367654e53 --- /dev/null +++ b/test/docx/golden/inline_formatting.docx diff --git a/test/docx/golden/inline_images.docx b/test/docx/golden/inline_images.docx Binary files differnew file mode 100644 index 000000000..6bd4b3a34 --- /dev/null +++ b/test/docx/golden/inline_images.docx diff --git a/test/docx/golden/link_in_notes.docx b/test/docx/golden/link_in_notes.docx Binary files differnew file mode 100644 index 000000000..c86f9aecd --- /dev/null +++ b/test/docx/golden/link_in_notes.docx diff --git a/test/docx/golden/links.docx b/test/docx/golden/links.docx Binary files differnew file mode 100644 index 000000000..652a93569 --- /dev/null +++ b/test/docx/golden/links.docx diff --git a/test/docx/golden/lists.docx b/test/docx/golden/lists.docx Binary files differnew file mode 100644 index 000000000..5e900feb1 --- /dev/null +++ b/test/docx/golden/lists.docx diff --git a/test/docx/golden/lists_continuing.docx b/test/docx/golden/lists_continuing.docx Binary files differnew file mode 100644 index 000000000..278edaa99 --- /dev/null +++ b/test/docx/golden/lists_continuing.docx diff --git a/test/docx/golden/lists_restarting.docx b/test/docx/golden/lists_restarting.docx Binary files differnew file mode 100644 index 000000000..112b824b5 --- /dev/null +++ b/test/docx/golden/lists_restarting.docx diff --git a/test/docx/golden/nested_anchors_in_header.docx b/test/docx/golden/nested_anchors_in_header.docx Binary files differnew file mode 100644 index 000000000..c2a10b828 --- /dev/null +++ b/test/docx/golden/nested_anchors_in_header.docx diff --git a/test/docx/golden/notes.docx b/test/docx/golden/notes.docx Binary files differnew file mode 100644 index 000000000..c6093c18a --- /dev/null +++ b/test/docx/golden/notes.docx diff --git a/test/docx/golden/table_one_row.docx b/test/docx/golden/table_one_row.docx Binary files differnew file mode 100644 index 000000000..34de65e2e --- /dev/null +++ b/test/docx/golden/table_one_row.docx diff --git a/test/docx/golden/table_with_list_cell.docx b/test/docx/golden/table_with_list_cell.docx Binary files differnew file mode 100644 index 000000000..c27f99736 --- /dev/null +++ b/test/docx/golden/table_with_list_cell.docx diff --git a/test/docx/golden/tables.docx b/test/docx/golden/tables.docx Binary files differnew file mode 100644 index 000000000..4fcdd73c3 --- /dev/null +++ b/test/docx/golden/tables.docx diff --git a/test/docx/golden/track_changes_deletion.docx b/test/docx/golden/track_changes_deletion.docx Binary files differnew file mode 100644 index 000000000..7b404dba1 --- /dev/null +++ b/test/docx/golden/track_changes_deletion.docx diff --git a/test/docx/golden/track_changes_insertion.docx b/test/docx/golden/track_changes_insertion.docx Binary files differnew file mode 100644 index 000000000..500a7c239 --- /dev/null +++ b/test/docx/golden/track_changes_insertion.docx diff --git a/test/docx/golden/track_changes_move.docx b/test/docx/golden/track_changes_move.docx Binary files differnew file mode 100644 index 000000000..05705c040 --- /dev/null +++ b/test/docx/golden/track_changes_move.docx diff --git a/test/docx/golden/unicode.docx b/test/docx/golden/unicode.docx Binary files differnew file mode 100644 index 000000000..c1626874d --- /dev/null +++ b/test/docx/golden/unicode.docx diff --git a/test/docx/golden/verbatim_subsuper.docx b/test/docx/golden/verbatim_subsuper.docx Binary files differnew file mode 100644 index 000000000..d2ada67fa --- /dev/null +++ b/test/docx/golden/verbatim_subsuper.docx diff --git a/test/docx/image_writer_test.native b/test/docx/image_writer_test.native new file mode 100644 index 000000000..a568cbca0 --- /dev/null +++ b/test/docx/image_writer_test.native @@ -0,0 +1,5 @@ +Pandoc (Meta {unMeta = fromList []}) +[Para [Image ("",[],[]) [] ("lalune.jpg","")] +,Para [Image ("",[],[]) [Str "The",Space,Str "Moon"] ("lalune.jpg","fig:")] +,Header 1 ("one-more",[],[]) [Str "One",Space,Str "More"] +,Para [Image ("",[],[]) [Str "The",Space,Str "Moon"] ("lalune.jpg","fig:")]]
\ No newline at end of file diff --git a/test/docx/inline_images_writer_test.native b/test/docx/inline_images_writer_test.native new file mode 100644 index 000000000..921a7aff8 --- /dev/null +++ b/test/docx/inline_images_writer_test.native @@ -0,0 +1,2 @@ +[Para [Str "This",Space,Str "picture",Space,Image ("",[],[("width","0.8888888888888888in"),("height","0.8888888888888888in")]) [Str "This",Space,Str "one",Space,Str "is",Space,Str "green",Space,Str "and",Space,Str "looks",Space,Str "like",Space,Str "Sideshow",Space,Str "Bob."] ("lalune.jpg","First identicon"),Space,Str "is",Space,Str "an",Space,Str "identicon."] +,Para [Str "Here",Space,Str "is",Space,Link ("",[],[]) [Str "one",Space,Image ("",[],[("width","0.8888888888888888in"),("height","0.8888888888888888in")]) [Str "This",Space,Str "one",Space,Str "is",Space,Str "reddish,",Space,Str "and",Space,Str "looks",Space,Str "like",Space,Str "a",Space,Str "heart",Space,Str "that",Space,Str "has",Space,Str "leaked",Space,Str "out."] ("lalune.jpg","Second identicon"),Space,Str "that"] ("http://www.google.com",""),Space,Str "links."]] |