From 3efdc3a8da642d5d76b2c3f10a22f0503f65456a Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 11 Feb 2019 12:27:41 -0500 Subject: Remove workaround for now-fixed Clang CPP bug (#1028) Before LLVM 6.0.1 (or 10.0 on Apple LLVM), there was a bug where lines that started with an octothorpe but turned out not to lex like pragmas would have an extra line added after them. Since this bug has been fixed upstream and that it doesn't have dire consequences anyways, the workaround is not really worth it anymore - we can just tell people to update their clang version (or re-structure their pragma code). --- hypsrc-test/Main.hs | 9 +-------- hypsrc-test/src/ClangCppBug.hs | 21 --------------------- 2 files changed, 1 insertion(+), 29 deletions(-) delete mode 100644 hypsrc-test/src/ClangCppBug.hs (limited to 'hypsrc-test') diff --git a/hypsrc-test/Main.hs b/hypsrc-test/Main.hs index 1963753d..f7614927 100644 --- a/hypsrc-test/Main.hs +++ b/hypsrc-test/Main.hs @@ -20,18 +20,11 @@ checkConfig = CheckConfig , ccfgEqual = (==) `on` dumpXml } where - -- The whole point of the ClangCppBug is to demonstrate a situation where - -- line numbers may vary (and test that links still work). Consequently, we - -- strip out line numbers for this test case. - strip f | takeBaseName f == "ClangCppBug" - = stripAnchors' . stripLinks' . stripIds' . stripIds'' . stripFooter - | otherwise - = stripAnchors' . stripLinks' . stripIds' . stripFooter + strip _ = stripAnchors' . stripLinks' . stripIds' . stripFooter stripLinks' = stripLinksWhen $ \href -> "#local-" `isPrefixOf` href stripAnchors' = stripAnchorsWhen $ \name -> "local-" `isPrefixOf` name stripIds' = stripIdsWhen $ \name -> "local-" `isPrefixOf` name - stripIds'' = stripIdsWhen $ \name -> "line-" `isPrefixOf` name dirConfig :: DirConfig diff --git a/hypsrc-test/src/ClangCppBug.hs b/hypsrc-test/src/ClangCppBug.hs deleted file mode 100644 index 4b0bc35f..00000000 --- a/hypsrc-test/src/ClangCppBug.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE CPP #-} -module ClangCppBug where - -foo :: Int -foo = 1 - --- Clang doesn't mind these: -#define BAX 2 -{-# INLINE bar #-} - -bar :: Int -bar = 3 - --- But it doesn't like this: -{-# RULES -"bar/qux" bar = qux -"qux/foo" qux = foo - #-} - -qux :: Int -qux = 88 -- cgit v1.2.3 From 80b8a8a2525d4e4c60b7c9439a23ac47d9612802 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 7 Oct 2019 15:13:52 -0400 Subject: Add a regression test for #1091 Previously, this input would crash Haddock. --- haddock.cabal | 1 + hypsrc-test/ref/src/Bug1091.html | 34 ++++++++++++++++++++++++++++++++++ hypsrc-test/src/Bug1091.hs | 4 ++++ hypsrc-test/src/Include1For1091.h | 6 ++++++ hypsrc-test/src/Include2For1091.h | 4 ++++ 5 files changed, 49 insertions(+) create mode 100644 hypsrc-test/ref/src/Bug1091.html create mode 100644 hypsrc-test/src/Bug1091.hs create mode 100644 hypsrc-test/src/Include1For1091.h create mode 100644 hypsrc-test/src/Include2For1091.h (limited to 'hypsrc-test') diff --git a/haddock.cabal b/haddock.cabal index 0173fd84..fa87e07e 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -46,6 +46,7 @@ extra-source-files: html-test/src/*.hs html-test/ref/*.html hypsrc-test/src/*.hs + hypsrc-test/src/*.h hypsrc-test/ref/src/*.html latex-test/src/**/*.hs latex-test/ref/**/*.tex diff --git a/hypsrc-test/ref/src/Bug1091.html b/hypsrc-test/ref/src/Bug1091.html new file mode 100644 index 00000000..730b6e25 --- /dev/null +++ b/hypsrc-test/ref/src/Bug1091.html @@ -0,0 +1,34 @@ +
{-# LANGUAGE CPP #-}
+module Bug1091 where
+
+#include "Include1For1091.h"
+
\ No newline at end of file diff --git a/hypsrc-test/src/Bug1091.hs b/hypsrc-test/src/Bug1091.hs new file mode 100644 index 00000000..f0cea033 --- /dev/null +++ b/hypsrc-test/src/Bug1091.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE CPP #-} +module Bug1091 where + +#include "Include1For1091.h" diff --git a/hypsrc-test/src/Include1For1091.h b/hypsrc-test/src/Include1For1091.h new file mode 100644 index 00000000..32854b95 --- /dev/null +++ b/hypsrc-test/src/Include1For1091.h @@ -0,0 +1,6 @@ +/* Include1For1091.h */ + +foo :: Int +foo = 42 + +#include "Include2For1091.h" diff --git a/hypsrc-test/src/Include2For1091.h b/hypsrc-test/src/Include2For1091.h new file mode 100644 index 00000000..c0848fa9 --- /dev/null +++ b/hypsrc-test/src/Include2For1091.h @@ -0,0 +1,4 @@ +/* Include2For1091.h */ + +bar :: Int +bar = 27 -- cgit v1.2.3 From cdf4445a877428f5969f712a95830af38029b9a0 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 7 Oct 2019 20:45:40 -0400 Subject: Add Hyperlinker test cases for TH-related stuff Hopefully this will guard against regressions around quasiquotes, TH quotes, and TH splices. --- hypsrc-test/ref/src/CallingQuotes.html | 104 ++++ hypsrc-test/ref/src/Quasiquoter.html | 415 +++++++++++++ .../ref/src/TemplateHaskellQuasiquotes.html | 659 +++++++++++++++++++++ hypsrc-test/ref/src/TemplateHaskellSplices.html | 135 +++++ hypsrc-test/ref/src/UsingQuasiquotes.html | 104 ++++ hypsrc-test/src/Quasiquoter.hs | 16 + hypsrc-test/src/TemplateHaskellQuasiquotes.hs | 39 ++ hypsrc-test/src/TemplateHaskellSplices.hs | 8 + hypsrc-test/src/UsingQuasiquotes.hs | 9 + 9 files changed, 1489 insertions(+) create mode 100644 hypsrc-test/ref/src/CallingQuotes.html create mode 100644 hypsrc-test/ref/src/Quasiquoter.html create mode 100644 hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html create mode 100644 hypsrc-test/ref/src/TemplateHaskellSplices.html create mode 100644 hypsrc-test/ref/src/UsingQuasiquotes.html create mode 100644 hypsrc-test/src/Quasiquoter.hs create mode 100644 hypsrc-test/src/TemplateHaskellQuasiquotes.hs create mode 100644 hypsrc-test/src/TemplateHaskellSplices.hs create mode 100644 hypsrc-test/src/UsingQuasiquotes.hs (limited to 'hypsrc-test') diff --git a/hypsrc-test/ref/src/CallingQuotes.html b/hypsrc-test/ref/src/CallingQuotes.html new file mode 100644 index 00000000..9b2e3209 --- /dev/null +++ b/hypsrc-test/ref/src/CallingQuotes.html @@ -0,0 +1,104 @@ +
{-# LANGUAGE QuasiQuotes #-}
+module CallingQuotes where
+
+import Quasiquoter
+
+baz :: [Char]
+baz  = [string| foo bar |] [Char] -> [Char] -> [Char]
+forall a. [a] -> [a] -> [a]
+++ [string| some
+  mulitline
+  quasiquote
+|]
+
\ No newline at end of file diff --git a/hypsrc-test/ref/src/Quasiquoter.html b/hypsrc-test/ref/src/Quasiquoter.html new file mode 100644 index 00000000..ab631e8c --- /dev/null +++ b/hypsrc-test/ref/src/Quasiquoter.html @@ -0,0 +1,415 @@ +
module Quasiquoter ( string ) where
+
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+
+-- | Quoter for constructing multiline string literals
+string :: QuasiQuoter
+string :: QuasiQuoter
+string = QuasiQuoter :: (String -> Q Exp)
+-> (String -> Q Pat)
+-> (String -> Q Type)
+-> (String -> Q [Dec])
+-> QuasiQuoter
+QuasiQuoter
+  { quoteExp :: String -> Q Exp
+quoteExp = Exp -> Q Exp
+forall (f :: * -> *) a. Applicative f => a -> f a
+pure (Exp -> Q Exp) -> (String -> Exp) -> String -> Q Exp
+forall b c a. (b -> c) -> (a -> b) -> a -> c
+. Lit -> Exp
+LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
+forall b c a. (b -> c) -> (a -> b) -> a -> c
+. String -> Lit
+StringL
+  , quotePat :: String -> Q Pat
+quotePat = String -> Q Pat
+forall a. String -> Q a
+invalidDomain
+  , quoteType :: String -> Q Type
+quoteType = String -> Q Type
+forall a. String -> Q a
+invalidDomain
+  , quoteDec :: String -> Q [Dec]
+quoteDec = String -> Q [Dec]
+forall a. String -> Q a
+invalidDomain
+  }
+  where
+    invalidDomain :: String -> Q a
+    invalidDomain :: String -> Q a
+invalidDomain _ = String -> Q a
+forall (m :: * -> *) a. MonadFail m => String -> m a
+fail "stringQuoter: only valid in expression context"
+
\ No newline at end of file diff --git a/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html b/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html new file mode 100644 index 00000000..6552b676 --- /dev/null +++ b/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html @@ -0,0 +1,659 @@ +
{-# LANGUAGE TemplateHaskell #-}
+
+module TemplateHaskellQuasiquotes where
+
+import Language.Haskell.TH
+
+aDecl :: DecsQ
+aDecl :: DecsQ
+aDecl = [d|
+    bar :: $aType -> [ (Int, String) ]
+    bar $aPattern = $anExpression
+  |]
+
+aPattern :: PatQ
+aPattern :: PatQ
+aPattern = [p|
+    [ aCrazyLongVariableName
+    , _unused
+    , (y, z)
+    , ( $aNumberPattern, "hello")
+    ]
+  |]
+
+aNumberPattern :: PatQ
+aNumberPattern :: PatQ
+aNumberPattern = [p|
+    w @ v @ 4.5
+  |]
+
+anExpression, anExpression2 :: ExpQ
+anExpression :: ExpQ
+anExpression = [e|
+    [ (1 + $anExpression2, "world") ]
+  |]
+anExpression2 :: ExpQ
+anExpression2 = [| (1 + round pi) |]
+
+aType :: TypeQ
+aType :: TypeQ
+aType = [t|
+    [ (Double, String) ]
+  |]
+
+
+
+
\ No newline at end of file diff --git a/hypsrc-test/ref/src/TemplateHaskellSplices.html b/hypsrc-test/ref/src/TemplateHaskellSplices.html new file mode 100644 index 00000000..85288453 --- /dev/null +++ b/hypsrc-test/ref/src/TemplateHaskellSplices.html @@ -0,0 +1,135 @@ +
{-# LANGUAGE TemplateHaskell #-}
+module TemplateHaskellSplices where
+
+import TemplateHaskellQuasiquotes
+
+$([(Double, String)] -> [(Int, String)]
+aDecl)
+
+foo :: Integer
+foo = Integer -> Integer
+forall a. a -> a
+id $(Double
+Double -> Integer
+Integer -> Integer -> Integer
+forall a. Floating a => a
+forall a. Num a => a -> a -> a
+forall a b. (RealFrac a, Integral b) => a -> b
++ :: forall a. Num a => a -> a -> a
+round :: forall a b. (RealFrac a, Integral b) => a -> b
+pi :: forall a. Floating a => a
+anExpression2)
+
\ No newline at end of file diff --git a/hypsrc-test/ref/src/UsingQuasiquotes.html b/hypsrc-test/ref/src/UsingQuasiquotes.html new file mode 100644 index 00000000..a5c791c4 --- /dev/null +++ b/hypsrc-test/ref/src/UsingQuasiquotes.html @@ -0,0 +1,104 @@ +
{-# LANGUAGE QuasiQuotes #-}
+module UsingQuasiquotes where
+
+import Quasiquoter
+
+baz :: [Char]
+baz  = [string| foo bar |] [Char] -> [Char] -> [Char]
+forall a. [a] -> [a] -> [a]
+++ [string| some
+  mulitline
+  quasiquote
+|]
+
\ No newline at end of file diff --git a/hypsrc-test/src/Quasiquoter.hs b/hypsrc-test/src/Quasiquoter.hs new file mode 100644 index 00000000..d0a46c33 --- /dev/null +++ b/hypsrc-test/src/Quasiquoter.hs @@ -0,0 +1,16 @@ +module Quasiquoter ( string ) where + +import Language.Haskell.TH.Quote +import Language.Haskell.TH.Syntax + +-- | Quoter for constructing multiline string literals +string :: QuasiQuoter +string = QuasiQuoter + { quoteExp = pure . LitE . StringL + , quotePat = invalidDomain + , quoteType = invalidDomain + , quoteDec = invalidDomain + } + where + invalidDomain :: String -> Q a + invalidDomain _ = fail "stringQuoter: only valid in expression context" diff --git a/hypsrc-test/src/TemplateHaskellQuasiquotes.hs b/hypsrc-test/src/TemplateHaskellQuasiquotes.hs new file mode 100644 index 00000000..a1661895 --- /dev/null +++ b/hypsrc-test/src/TemplateHaskellQuasiquotes.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE TemplateHaskell #-} + +module TemplateHaskellQuasiquotes where + +import Language.Haskell.TH + +aDecl :: DecsQ +aDecl = [d| + bar :: $aType -> [ (Int, String) ] + bar $aPattern = $anExpression + |] + +aPattern :: PatQ +aPattern = [p| + [ aCrazyLongVariableName + , _unused + , (y, z) + , ( $aNumberPattern, "hello") + ] + |] + +aNumberPattern :: PatQ +aNumberPattern = [p| + w @ v @ 4.5 + |] + +anExpression, anExpression2 :: ExpQ +anExpression = [e| + [ (1 + $anExpression2, "world") ] + |] +anExpression2 = [| (1 + round pi) |] + +aType :: TypeQ +aType = [t| + [ (Double, String) ] + |] + + + diff --git a/hypsrc-test/src/TemplateHaskellSplices.hs b/hypsrc-test/src/TemplateHaskellSplices.hs new file mode 100644 index 00000000..bbd3948e --- /dev/null +++ b/hypsrc-test/src/TemplateHaskellSplices.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +module TemplateHaskellSplices where + +import TemplateHaskellQuasiquotes + +$(aDecl) + +foo = id $(anExpression2) diff --git a/hypsrc-test/src/UsingQuasiquotes.hs b/hypsrc-test/src/UsingQuasiquotes.hs new file mode 100644 index 00000000..34872d4d --- /dev/null +++ b/hypsrc-test/src/UsingQuasiquotes.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE QuasiQuotes #-} +module UsingQuasiquotes where + +import Quasiquoter + +baz = [string| foo bar |] ++ [string| some + mulitline + quasiquote +|] -- cgit v1.2.3