From 70d2a4704bf42f3cb66ae90168a255fa2dc560e2 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Sun, 16 Aug 2015 17:36:10 +0300 Subject: [PATCH] Tests for TH, LHS and CPP with FileMapping --- test/FileMappingSpec.hs | 85 +++++++++++++++++++ test/data/file-mapping/lhs/File.lhs | 2 + test/data/file-mapping/lhs/File_Redir.lhs | 1 + .../data/file-mapping/lhs/File_Redir_Lint.lhs | 4 + test/data/file-mapping/preprocessor/File.hs | 7 ++ .../file-mapping/preprocessor/File_Redir.hs | 6 ++ .../preprocessor/File_Redir_Lint.hs | 9 ++ 7 files changed, 114 insertions(+) create mode 100644 test/data/file-mapping/lhs/File.lhs create mode 100644 test/data/file-mapping/lhs/File_Redir.lhs create mode 100644 test/data/file-mapping/lhs/File_Redir_Lint.lhs create mode 100644 test/data/file-mapping/preprocessor/File.hs create mode 100644 test/data/file-mapping/preprocessor/File_Redir.hs create mode 100644 test/data/file-mapping/preprocessor/File_Redir_Lint.hs diff --git a/test/FileMappingSpec.hs b/test/FileMappingSpec.hs index 18c583a..aec408a 100644 --- a/test/FileMappingSpec.hs +++ b/test/FileMappingSpec.hs @@ -6,6 +6,7 @@ import Test.Hspec import TestUtils import qualified Data.Map as M import Dir +import System.IO.Temp import Language.Haskell.GhcMod @@ -116,3 +117,87 @@ spec = do loadMappedFile "File.hs" (MemoryMapping $ Just "module File where\n\ntestfun = putStrLn \"Hello!\"") info "File.hs" $ Expression "testfun" res `shouldBe` "testfun :: IO () \t-- Defined at File.hs:3:1\n" + + describe "preprocessor tests" $ do + it "checks redirected file if one is specified and outputs original filename" $ do + withDirectory_ "test/data/file-mapping/preprocessor" $ do + let fm = [("File.hs", RedirectedMapping "File_Redir.hs")] + res <- run defaultOptions $ do + mapM_ (uncurry loadMappedFile) fm + checkSyntax ["File.hs"] + res `shouldBe` "File.hs:3:1:Warning: Top-level binding with no type signature: main :: IO ()\n" + it "checks in-memory file if one is specified and outputs original filename" $ do + withDirectory_ "test/data/file-mapping/preprocessor" $ do + src <- readFile "File_Redir.hs" + let fm = [("File.hs", MemoryMapping $ Just src)] + res <- run defaultOptions $ do + mapM_ (uncurry loadMappedFile) fm + checkSyntax ["File.hs"] + res `shouldBe` "File.hs:3:1:Warning: Top-level binding with no type signature: main :: IO ()\n" + it "lints redirected file if one is specified and outputs original filename" $ do + withDirectory_ "test/data/file-mapping/preprocessor" $ do + res <- runD $ do + loadMappedFile "File.hs" (RedirectedMapping "File_Redir_Lint.hs") + lint "File.hs" + res `shouldBe` "File.hs:6:1: Error: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" + it "lints in-memory file if one is specified and outputs original filename" $ do + withDirectory_ "test/data/file-mapping/preprocessor" $ do + src <- readFile "File_Redir_Lint.hs" + res <- runD $ do + loadMappedFile "File.hs" (MemoryMapping $ Just src) + lint "File.hs" + res `shouldBe` "File.hs:6:1: Error: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" + describe "literate haskell tests" $ do + it "checks redirected file if one is specified and outputs original filename" $ do + withDirectory_ "test/data/file-mapping/lhs" $ do + let fm = [("File.lhs", RedirectedMapping "File_Redir.lhs")] + res <- run defaultOptions $ do + mapM_ (uncurry loadMappedFile) fm + checkSyntax ["File.lhs"] + res `shouldBe` "File.lhs:1:3:Warning: Top-level binding with no type signature: main :: IO ()\n" + it "checks in-memory file if one is specified and outputs original filename" $ do + withDirectory_ "test/data/file-mapping/lhs" $ do + src <- readFile "File_Redir.lhs" + let fm = [("File.lhs", MemoryMapping $ Just src)] + res <- run defaultOptions $ do + mapM_ (uncurry loadMappedFile) fm + checkSyntax ["File.lhs"] + res `shouldBe` "File.lhs:1:3:Warning: Top-level binding with no type signature: main :: IO ()\n" + -- NOTE: There is a bug in hlint that prevents it from linting lhs files. + -- it "lints redirected file if one is specified and outputs original filename" $ do + -- withDirectory_ "test/data/file-mapping/lhs" $ do + -- res <- runD $ do + -- loadMappedFile "File.lhs" (RedirectedMapping "File_Redir_Lint.lhs") + -- lint "File.lhs" + -- res `shouldBe` "File.lhs:6:1: Error: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" + -- it "lints in-memory file if one is specified and outputs original filename" $ do + -- withDirectory_ "test/data/file-mapping/lhs" $ do + -- src <- readFile "File_Redir_Lint.lhs" + -- res <- runD $ do + -- loadMappedFile "File.lhs" (MemoryMapping $ Just src) + -- lint "File.lhs" + -- res `shouldBe` "File.lhs:6:1: Error: Eta reduce\NULFound:\NUL func a b = (*) a b\NULWhy not:\NUL func = (*)\n" + describe "template haskell" $ do + it "works with a redirected module using TemplateHaskell" $ do + withSystemTempDirectory "ghc-mod-test" $ \tmpdir -> do + srcFoo <- readFile "test/data/template-haskell/Foo.hs" + srcBar <- readFile "test/data/template-haskell/Bar.hs" + withDirectory_ "test/data/file-mapping" $ do + writeFile (tmpdir "Foo_Redir.hs") srcFoo + writeFile (tmpdir "Bar_Redir.hs") srcBar + let fm = [("Foo.hs", RedirectedMapping $ tmpdir "Foo_Redir.hs") + ,("Bar.hs", RedirectedMapping $ tmpdir "Bar_Redir.hs")] + res <- run defaultOptions $ do + mapM_ (uncurry loadMappedFile) fm + types "Bar.hs" 5 1 + res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] + it "works with a memory module using TemplateHaskell" $ do + srcFoo <- readFile "test/data/template-haskell/Foo.hs" + srcBar <- readFile "test/data/template-haskell/Bar.hs" + withDirectory_ "test/data/file-mapping" $ do + let fm = [("Foo.hs", MemoryMapping $ Just srcFoo) + ,("Bar.hs", MemoryMapping $ Just srcBar)] + res <- run defaultOptions $ do + mapM_ (uncurry loadMappedFile) fm + types "Bar.hs" 5 1 + res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] diff --git a/test/data/file-mapping/lhs/File.lhs b/test/data/file-mapping/lhs/File.lhs new file mode 100644 index 0000000..3ec4635 --- /dev/null +++ b/test/data/file-mapping/lhs/File.lhs @@ -0,0 +1,2 @@ +> main :: IO () +> main = putStrLn "Hello World!" diff --git a/test/data/file-mapping/lhs/File_Redir.lhs b/test/data/file-mapping/lhs/File_Redir.lhs new file mode 100644 index 0000000..26d462c --- /dev/null +++ b/test/data/file-mapping/lhs/File_Redir.lhs @@ -0,0 +1 @@ +> main = putStrLn "Hello World!" diff --git a/test/data/file-mapping/lhs/File_Redir_Lint.lhs b/test/data/file-mapping/lhs/File_Redir_Lint.lhs new file mode 100644 index 0000000..66bf9ca --- /dev/null +++ b/test/data/file-mapping/lhs/File_Redir_Lint.lhs @@ -0,0 +1,4 @@ +> module File where + +> func :: Num a => a -> a -> a +> func a b = (*) a b diff --git a/test/data/file-mapping/preprocessor/File.hs b/test/data/file-mapping/preprocessor/File.hs new file mode 100644 index 0000000..41d1be2 --- /dev/null +++ b/test/data/file-mapping/preprocessor/File.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CPP #-} +#ifndef NOTHING +main :: IO () +main = putStrLn "Hello World!" +#else +INVALID +#endif diff --git a/test/data/file-mapping/preprocessor/File_Redir.hs b/test/data/file-mapping/preprocessor/File_Redir.hs new file mode 100644 index 0000000..ca07e79 --- /dev/null +++ b/test/data/file-mapping/preprocessor/File_Redir.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE CPP #-} +#ifndef NOTHING +main = putStrLn "Hello World!" +#else +INVALID +#endif diff --git a/test/data/file-mapping/preprocessor/File_Redir_Lint.hs b/test/data/file-mapping/preprocessor/File_Redir_Lint.hs new file mode 100644 index 0000000..8f8e298 --- /dev/null +++ b/test/data/file-mapping/preprocessor/File_Redir_Lint.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} +#ifndef NOTHING +module File where + +func :: Num a => a -> a -> a +func a b = (*) a b +#else +INVALID +#endif