diff --git a/test/data/THNewName/A.hs b/test/data/THNewName/A.hs new file mode 100644 index 000000000..897983d23 --- /dev/null +++ b/test/data/THNewName/A.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} + +module A (template) where + +import Language.Haskell.TH + +template :: DecsQ +template = (\consA -> [DataD [] (mkName "A") [] Nothing [NormalC consA []] []]) <$> newName "A" diff --git a/test/data/THNewName/B.hs b/test/data/THNewName/B.hs new file mode 100644 index 000000000..be4a0bd0f --- /dev/null +++ b/test/data/THNewName/B.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +module B(A(A)) where + +import A + +template diff --git a/test/data/THNewName/C.hs b/test/data/THNewName/C.hs new file mode 100644 index 000000000..b1631f9ea --- /dev/null +++ b/test/data/THNewName/C.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE TemplateHaskell #-} +module C where +import B + +a = A diff --git a/test/exe/Main.hs b/test/exe/Main.hs index 5ca19dc20..aab8a592b 100644 --- a/test/exe/Main.hs +++ b/test/exe/Main.hs @@ -2274,6 +2274,20 @@ thTests = _ <- createDoc "A.hs" "haskell" sourceA _ <- createDoc "B.hs" "haskell" sourceB expectDiagnostics [ ( "B.hs", [(DsWarning, (4, 0), "Top-level binding with no type signature: main :: IO ()")] ) ] + , testCase "findsTHnewNameConstructor" $ withoutStackEnv $ runWithExtraFiles "THNewName" $ \dir -> do + + let cPath = dir </> "C.hs" + + -- This test defines a TH value with the meaning "data A = A" in A.hs + -- Loads and export the template in B.hs + -- And checks wether the constructor A can be loaded in C.hs + -- This test does not fail when either A and B get manually loaded before C.hs + -- or when we remove the seemingly unnecessary TH pragma from C.hs + cSource <- liftIO $ readFileUtf8 cPath + + _ <- createDoc cPath "haskell" cSource + + expectDiagnostics [ ( cPath, [(DsWarning, (5, 0), "Top-level binding with no type signature: a :: A")] ) ] ] -- | test that TH is reevaluated on typecheck