aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore1
-rw-r--r--haddock.cabal10
-rwxr-xr-xlatex-test/accept.lhs46
-rw-r--r--latex-test/ref/Simple/Simple.tex17
-rw-r--r--latex-test/ref/Simple/haddock.sty57
-rw-r--r--latex-test/ref/Simple/main.tex11
-rwxr-xr-xlatex-test/run.lhs162
-rw-r--r--latex-test/src/Simple/Simple.hs5
8 files changed, 309 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
index b516bcf8..bc554c00 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,6 @@
/dist/
/html-test/out/
+/latex-test/out/
/doc/haddock
/doc/autom4te.cache/
diff --git a/haddock.cabal b/haddock.cabal
index ac13ae88..054a50f9 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -31,6 +31,9 @@ extra-source-files:
src/haddock.sh
html-test/src/*.hs
html-test/ref/*.html
+ latex-test/src/*.hs
+ latex-test/ref/*/*.tex
+ latex-test/ref/*/*.sty
data-dir: resources
data-files: html/frames.html
@@ -189,6 +192,13 @@ test-suite html-test
hs-source-dirs: html-test
build-depends: base, directory, process, filepath, Cabal
+test-suite latex-test
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ main-is: run.lhs
+ hs-source-dirs: latex-test
+ build-depends: base, directory, process, filepath, Cabal
+
test-suite spec
type: exitcode-stdio-1.0
default-language: Haskell2010
diff --git a/latex-test/accept.lhs b/latex-test/accept.lhs
new file mode 100755
index 00000000..4d0b0127
--- /dev/null
+++ b/latex-test/accept.lhs
@@ -0,0 +1,46 @@
+#!/usr/bin/env runhaskell
+\begin{code}
+{-# LANGUAGE CPP #-}
+import System.Environment
+import System.FilePath
+import System.Directory
+import Data.List
+import Control.Applicative
+import Control.Monad
+
+baseDir :: FilePath
+baseDir = takeDirectory __FILE__
+
+main :: IO ()
+main = do
+ contents <- filter (not . ignore) <$> getDirectoryContents (baseDir </> "out")
+ args <- getArgs
+ mapM_ copyDir $ if not (null args)
+ then filter ((`elem` args) . takeBaseName) contents
+ else contents
+ where
+ ignore =
+ foldr (liftA2 (||)) (const False) [
+ (== ".")
+ , (== "..")
+ , isPrefixOf "index"
+ , isPrefixOf "doc-index"
+ ]
+
+-- | Copy a directory to ref, one level deep.
+copyDir :: FilePath -> IO ()
+copyDir dir = do
+ let old = baseDir </> "out" </> dir
+ new = baseDir </> "ref" </> dir
+ alreadyExists <- doesDirectoryExist new
+ unless alreadyExists $ do
+ putStrLn (old ++ " -> " ++ new)
+ createDirectoryIfMissing True new
+ files <- getDirectoryContents old >>= filterM (liftM not . doesDirectoryExist)
+ let files' = filter (\x -> x /= "." && x /= "..") files
+ mapM_ (\f -> copyFile' (old </> f) (new </> f)) files'
+ where
+ copyFile' o n = do
+ putStrLn $ o ++ " -> " ++ n
+ copyFile o n
+\end{code}
diff --git a/latex-test/ref/Simple/Simple.tex b/latex-test/ref/Simple/Simple.tex
new file mode 100644
index 00000000..89e849f8
--- /dev/null
+++ b/latex-test/ref/Simple/Simple.tex
@@ -0,0 +1,17 @@
+\haddockmoduleheading{Simple}
+\label{module:Simple}
+\haddockbeginheader
+{\haddockverb\begin{verbatim}
+module Simple (
+ foo
+ ) where\end{verbatim}}
+\haddockendheader
+
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+foo\ ::\ t
+\end{tabular}]\haddockbegindoc
+This is foo.
+\par
+
+\end{haddockdesc} \ No newline at end of file
diff --git a/latex-test/ref/Simple/haddock.sty b/latex-test/ref/Simple/haddock.sty
new file mode 100644
index 00000000..6e031a98
--- /dev/null
+++ b/latex-test/ref/Simple/haddock.sty
@@ -0,0 +1,57 @@
+% Default Haddock style definitions. To use your own style, invoke
+% Haddock with the option --latex-style=mystyle.
+
+\usepackage{tabulary} % see below
+
+% make hyperlinks in the PDF, and add an expandabale index
+\usepackage[pdftex,bookmarks=true]{hyperref}
+
+\newenvironment{haddocktitle}
+ {\begin{center}\bgroup\large\bfseries}
+ {\egroup\end{center}}
+\newenvironment{haddockprologue}{\vspace{1in}}{}
+
+\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}}
+
+\newcommand{\haddockbeginheader}{\hrulefill}
+\newcommand{\haddockendheader}{\noindent\hrulefill}
+
+% a little gap before the ``Methods'' header
+\newcommand{\haddockpremethods}{\vspace{2ex}}
+
+% inserted before \\begin{verbatim}
+\newcommand{\haddockverb}{\small}
+
+% an identifier: add an index entry
+\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}}
+
+% The tabulary environment lets us have a column that takes up ``the
+% rest of the space''. Unfortunately it doesn't allow
+% the \end{tabulary} to be in the expansion of a macro, it must appear
+% literally in the document text, so Haddock inserts
+% the \end{tabulary} itself.
+\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+
+\newcommand{\haddocktt}[1]{{\small \texttt{#1}}}
+\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}}
+
+\makeatletter
+\newenvironment{haddockdesc}
+ {\list{}{\labelwidth\z@ \itemindent-\leftmargin
+ \let\makelabel\haddocklabel}}
+ {\endlist}
+\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}}
+\makeatother
+
+% after a declaration, start a new line for the documentation.
+% Otherwise, the documentation starts right after the declaration,
+% because we're using the list environment and the declaration is the
+% ``label''. I tried making this newline part of the label, but
+% couldn't get that to work reliably (the space seemed to stretch
+% sometimes).
+\newcommand{\haddockbegindoc}{\hfill\\[1ex]}
+
+% spacing between paragraphs and no \parindent looks better
+\parskip=10pt plus2pt minus2pt
+\setlength{\parindent}{0cm}
diff --git a/latex-test/ref/Simple/main.tex b/latex-test/ref/Simple/main.tex
new file mode 100644
index 00000000..36536981
--- /dev/null
+++ b/latex-test/ref/Simple/main.tex
@@ -0,0 +1,11 @@
+\documentclass{book}
+\usepackage{haddock}
+\begin{document}
+\begin{titlepage}
+\begin{haddocktitle}
+
+\end{haddocktitle}
+\end{titlepage}
+\tableofcontents
+\input{Simple}
+\end{document} \ No newline at end of file
diff --git a/latex-test/run.lhs b/latex-test/run.lhs
new file mode 100755
index 00000000..423dc6fd
--- /dev/null
+++ b/latex-test/run.lhs
@@ -0,0 +1,162 @@
+#!/usr/bin/env runhaskell
+\begin{code}
+{-# LANGUAGE CPP #-}
+import Prelude hiding (mod)
+import Control.Monad
+import Control.Applicative
+import Data.List
+import Data.Maybe
+import Distribution.InstalledPackageInfo
+import Distribution.Package (PackageName (..))
+import Distribution.Simple.Compiler
+import Distribution.Simple.GHC
+import Distribution.Simple.PackageIndex
+import Distribution.Simple.Program
+import Distribution.Simple.Utils
+import Distribution.Verbosity
+import System.IO
+import System.Directory
+import System.Environment
+import System.Exit
+import System.FilePath
+import System.Process (ProcessHandle, runProcess, waitForProcess, system)
+
+
+packageRoot, dataDir, haddockPath, baseDir, testDir, outDir, refDir :: FilePath
+baseDir = takeDirectory __FILE__
+testDir = baseDir </> "src"
+refDir = baseDir </> "ref"
+outDir = baseDir </> "out"
+packageRoot = baseDir </> ".."
+dataDir = packageRoot </> "resources"
+haddockPath = packageRoot </> "dist" </> "build" </> "haddock" </> "haddock"
+
+
+main :: IO ()
+main = do
+ test
+ putStrLn "All tests passed!"
+
+
+test :: IO ()
+test = do
+ x <- doesFileExist haddockPath
+ unless x $ die "you need to run 'cabal build' successfully first"
+
+ contents <- getDirectoryContents testDir
+
+ args <- getArgs
+ let (opts, spec) = span ("-" `isPrefixOf`) args
+ isDir x' = liftM2 (&&) (doesDirectoryExist $ testDir </> x')
+ (return $ x' /= "." && x' /= "..")
+ modDirs <- case spec of
+ y:_ | y /= "all" -> return [y]
+ _ -> filterM isDir contents
+
+ let modDirs' = map (testDir </>) modDirs
+
+ -- add haddock_datadir to environment for subprocesses
+ env <- Just . (:) ("haddock_datadir", dataDir) <$> getEnvironment
+
+ putStrLn ""
+ putStrLn "Haddock version: "
+ h1 <- runProcess haddockPath ["--version"] Nothing
+ env Nothing Nothing Nothing
+ wait h1 "*** Running `haddock --version' failed!"
+ putStrLn ""
+ putStrLn "GHC version: "
+ h2 <- runProcess haddockPath ["--ghc-version"] Nothing
+ env Nothing Nothing Nothing
+ wait h2 "*** Running `haddock --ghc-version' failed!"
+ putStrLn ""
+
+ -- TODO: maybe do something more clever here using haddock.cabal
+ ghcPath <- fmap init $ rawSystemStdout normal haddockPath ["--print-ghc-path"]
+ (_, _, conf) <- configure normal (Just ghcPath) Nothing defaultProgramConfiguration
+ pkgIndex <- getInstalledPackages normal [GlobalPackageDB] conf
+ let mkDep pkgName =
+ fromMaybe (error "Couldn't find test dependencies") $ do
+ let pkgs = lookupPackageName pkgIndex (PackageName pkgName)
+ (_, pkgs') <- listToMaybe pkgs
+ pkg <- listToMaybe pkgs'
+ ifacePath <- listToMaybe (haddockInterfaces pkg)
+ htmlPath <- listToMaybe (haddockHTMLs pkg)
+ return ("-i " ++ htmlPath ++ "," ++ ifacePath)
+
+ let base = mkDep "base"
+ process = mkDep "process"
+ ghcprim = mkDep "ghc-prim"
+
+ putStrLn "Running tests..."
+
+ forM_ modDirs' $ \modDir -> do
+ testModules <- getDirectoryContents modDir
+
+ let mods = filter ((==) ".hs" . takeExtension) testModules
+ mods' = map (modDir </>) mods
+
+ unless (null mods') $ do
+ handle <- runProcess haddockPath
+ (["-w", "-o", outDir </> last (splitPath modDir), "--latex"
+ , "--optghc=-fglasgow-exts"
+ , "--optghc=-w", base, process, ghcprim] ++ opts ++ mods')
+ Nothing env Nothing
+ Nothing Nothing
+
+ wait handle "*** Haddock run failed! Exiting."
+
+ check modDirs (if not (null args) && args !! 0 == "all" then False else True)
+ where
+ wait :: ProcessHandle -> String -> IO ()
+ wait h msg = do
+ r <- waitForProcess h
+ unless (r == ExitSuccess) $ do
+ hPutStrLn stderr msg
+ exitFailure
+
+check :: [FilePath] -> Bool -> IO ()
+check modDirs strict = do
+ forM_ modDirs $ \modDir -> do
+ let oDir = outDir </> modDir
+ rDir = refDir </> modDir
+
+ refDirExists <- doesDirectoryExist rDir
+ when refDirExists $ do
+ -- we're not creating sub-directories, I think.
+ refFiles <- getDirectoryContents rDir >>= filterM doesFileExist
+
+ forM_ refFiles $ \rFile -> do
+ let refFile = rDir </> rFile
+ outFile = oDir </> rFile
+ oe <- doesFileExist outFile
+ if oe
+ then do
+ out <- readFile outFile
+ ref <- readFile refFile
+
+ if out /= ref
+ then do
+ putStrLn $ "Output for " ++ modDir ++ " has changed! Exiting with diff:"
+
+ let reffile' = outDir </> takeFileName refFile ++ ".nolinks"
+ outfile' = outDir </> takeFileName outFile ++ ".ref.nolinks"
+ writeFile reffile' ref
+ writeFile outfile' out
+ r <- programOnPath "colordiff"
+ code <- if r
+ then system $ "colordiff " ++ reffile' ++ " " ++ outfile'
+ else system $ "diff " ++ reffile' ++ " " ++ outfile'
+ if strict then exitFailure else return ()
+ unless (code == ExitSuccess) $ do
+ hPutStrLn stderr "*** Running diff failed!"
+ exitFailure
+ else do
+ putStrLn $ "Pass: " ++ modDir
+ else do
+ putStrLn $ "Pass: " ++ modDir ++ " (no .ref file)"
+
+programOnPath :: FilePath -> IO Bool
+programOnPath p = do
+ result <- findProgramLocation silent p
+ return (isJust result)
+\end{code}
diff --git a/latex-test/src/Simple/Simple.hs b/latex-test/src/Simple/Simple.hs
new file mode 100644
index 00000000..7c6b9744
--- /dev/null
+++ b/latex-test/src/Simple/Simple.hs
@@ -0,0 +1,5 @@
+module Simple (foo) where
+
+-- | This is foo.
+foo :: t
+foo = undefined