From b404f297a559abc3f6b667e6f1137024b40f4e63 Mon Sep 17 00:00:00 2001 From: Andrew Gibiansky Date: Fri, 13 Dec 2013 18:00:41 -0800 Subject: [PATCH] Removed doctests, switched to hspec --- .gitignore | 1 + Hspec.hs | 189 ++++++++++++++++++++++++++++++++++++++ IHaskell.cabal | 39 ++++++-- IHaskell/Eval/Evaluate.hs | 3 +- IHaskell/Eval/Parser.hs | 124 +------------------------ IHaskell/IPython.hs | 7 -- rundoctests.hs | 43 --------- 7 files changed, 229 insertions(+), 177 deletions(-) create mode 100644 Hspec.hs delete mode 100644 rundoctests.hs diff --git a/.gitignore b/.gitignore index 0b3a6a97..baf328e9 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,4 @@ env .shelly .ihaskell_capture .ipynb_checkpoints +Hspec diff --git a/Hspec.hs b/Hspec.hs new file mode 100644 index 00000000..5c0bc2d9 --- /dev/null +++ b/Hspec.hs @@ -0,0 +1,189 @@ +import GHC +import GHC.Paths +import IHaskell.Eval.Parser +import IHaskell.IPython + +import Test.Hspec +import Test.Hspec.HUnit + +doGhc = runGhc (Just libdir) + +parses = doGhc . parseString + +like parser desired = parser >>= (`shouldBe` desired) + +is string blockType = do + result <- doGhc $ parseString string + result `shouldBe` [blockType string] + + +main :: IO () +main = hspec $ do + parserTests + ipythonTests + +ipythonTests = do + describe "Parse IPython Version" $ do + it "parses 2.0.0-dev" $ + parseVersion "2.0.0-dev" `shouldBe` [2, 0, 0] + it "parses 2.0.0-alpha" $ + parseVersion "2.0.0-dev" `shouldBe` [2, 0, 0] + it "parses 12.5.10" $ + parseVersion "12.5.10" `shouldBe` [12, 5, 10] + +parserTests = do + splitAtLocTests + layoutChunkerTests + moduleNameTests + parseStringTests + + +splitAtLocTests = describe "String Splitting Util" $ do + it "splits properly (example 1)" $ + splitAtLoc 2 3 "abc\ndefghi\nxyz\n123" `shouldBe` ("abc\nde","fghi\nxyz\n123") + it "splits properly (example 2)" $ + splitAtLoc 2 1 "abc" `shouldBe` ("abc","") + it "splits properly (example 3)" $ + splitAtLoc 2 1 "abc\nhello" `shouldBe` ("abc\n","hello") + +layoutChunkerTests = describe "Layout Chunk" $ do + it "chunks 'a string'" $ + layoutChunks "a string" `shouldBe` ["a string"] + + it "chunks 'a\\nstring'" $ + layoutChunks "a\n string" `shouldBe` ["a\n string"] + + it "chunks 'a\\n string\\nextra'" $ + layoutChunks "a\n string\nextra" `shouldBe` ["a\n string","extra"] + +moduleNameTests = describe "Get Module Name" $ do + it "parses simple module names" $ + "module A where\nx = 3" `named` ["A"] + it "parses module names with dots" $ + "module A.B where\nx = 3" `named` ["A", "B"] + it "parses module names with exports" $ + "module A.B.C ( x ) where x = 3" `named` ["A", "B", "C"] + it "errors when given unnamed modules" $ do + doGhc (getModuleName "x = 3") `shouldThrow` anyException + where + named str result = do + res <- doGhc $ getModuleName str + res `shouldBe` result + +parseStringTests = describe "Parser" $ do + it "parses empty strings" $ + parses "" `like` [] + + it "parses simple imports" $ + "import Data.Monoid" `is` Import + + it "parses simple arithmetic" $ + "3 + 5" `is` Expression + + it "parses :type" $ + parses ":type x\n:ty x" `like` [ + Directive GetType "x", + Directive GetType "x" + ] + + it "parses :info" $ + parses ":info x\n:in x" `like` [ + Directive GetInfo "x", + Directive GetInfo "x" + ] + + it "parses :help and :?" $ + parses ":? x\n:help x" `like` [ + Directive GetHelp "x", + Directive GetHelp "x" + ] + + it "parses :set x" $ + parses ":set x" `like` [ + Directive HelpForSet "x" + ] + + it "parses :extension x" $ + parses ":ex x\n:extension x" `like` [ + Directive SetExtension "x", + Directive SetExtension "x" + ] + + it "fails to parse :nope" $ + parses ":nope goodbye" `like` [ + ParseError (Loc 1 1) "Unknown directive: 'nope'." + ] + + it "parses number followed by let stmt" $ + parses "3\nlet x = expr" `like` [ + Expression "3", + Statement "let x = expr" + ] + + it "parses let x in y" $ + "let x = 3 in x + 3" `is` Expression + + it "parses a data declaration" $ + "data X = Y Int" `is` Declaration + + it "parses number followed by type directive" $ + parses "3\n:t expr" `like` [ + Expression "3", + Directive GetType "expr" + ] + + it "parses a <- statement" $ + "y <- print 'no'" `is` Statement + + it "parses a <- stmt followed by let stmt" $ + parses "y <- do print 'no'\nlet x = expr" `like` [ + Statement "y <- do { print 'no' }", + Statement "let x = expr" + ] + + it "parses <- followed by let followed by expr" $ + parses "y <- do print 'no'\nlet x = expr\nexpression" `like` [ + Statement "y <- do { print 'no' }", + Statement "let x = expr", + Expression "expression" + ] + + it "parses two print statements" $ + parses "print yes\nprint no" `like` [ + Expression "print yes", + Expression "print no" + ] + + it "parses a pattern-maching function declaration" $ + "fun [] = 10" `is` Declaration + + it "parses a function decl followed by an expression" $ + parses "fun [] = 10\nprint 'h'" `like` [ + Declaration "fun [] = 10", + Expression "print 'h'" + ] + + it "parses list pattern matching fun decl" $ + "fun (x : xs) = 100" `is` Declaration + + it "parses two pattern matches as the same declaration" $ + "fun [] = 10\nfun (x : xs) = 100" `is` Declaration + + it "parses a type signature followed by a declaration" $ + "fun :: [a] -> Int\nfun [] = 10\nfun (x : xs) = 100" `is` Declaration + + it "parases a simple module" $ + "module A where x = 3" `is` Module + + it "parses a module with an export" $ + "module B (x) where x = 3" `is` Module + + it "breaks when a let is incomplete" $ + parses "let x = 3 in" `like` [ + ParseError (Loc 1 13) "parse error (possibly incorrect indentation or mismatched brackets)" + ] + + it "breaks without data kinds" $ + parses "data X = 3" `like` [ + ParseError (Loc 1 10) "Illegal literal in type (use -XDataKinds to enable): 3" + ] diff --git a/IHaskell.cabal b/IHaskell.cabal index 355e85fd..acf0c44a 100644 --- a/IHaskell.cabal +++ b/IHaskell.cabal @@ -46,6 +46,7 @@ cabal-version: >=1.8 library build-depends: base ==4.6.*, + hspec, zeromq3-haskell ==0.5.*, aeson ==0.6.*, MissingH ==1.2.*, @@ -63,10 +64,12 @@ library shelly ==1.3.*, system-argv0, directory, - cereal ==0.3.*, here, system-filepath, - text ==0.11.* + cereal ==0.3.*, + text ==0.11.*, + mtl == 2.1.*, + template-haskell exposed-modules: IHaskell.Display, IHaskell.Types, IHaskell.Message.UUID @@ -96,6 +99,7 @@ executable IHaskell -- Other library packages from which modules are imported. build-depends: base ==4.6.*, + hspec, zeromq3-haskell ==0.5.*, aeson ==0.6.*, MissingH ==1.2.*, @@ -120,9 +124,32 @@ executable IHaskell mtl == 2.1.*, template-haskell -Test-Suite doctests +Test-Suite hspec Type: exitcode-stdio-1.0 Ghc-Options: -threaded - Main-Is: rundoctests.hs - Build-Depends: base, doctest >= 0.8, process, text ==0.11.*, shelly ==1.3.*, MissingH ==1.2.* - + Main-Is: Hspec.hs + build-depends: base ==4.6.*, + hspec, + zeromq3-haskell ==0.5.*, + aeson ==0.6.*, + MissingH ==1.2.*, + basic-prelude ==0.3.*, + classy-prelude ==0.6.*, + bytestring ==0.10.*, + uuid >=1.2.6, + containers ==0.5.*, + ghc ==7.6.*, + ghc-paths ==0.1.*, + random ==1.0.*, + split, + utf8-string, + strict ==0.3.*, + shelly ==1.3.*, + system-argv0, + directory, + here, + system-filepath, + cereal ==0.3.*, + text ==0.11.*, + mtl == 2.1.*, + template-haskell diff --git a/IHaskell/Eval/Evaluate.hs b/IHaskell/Eval/Evaluate.hs index 0feb24a2..9ec98e79 100644 --- a/IHaskell/Eval/Evaluate.hs +++ b/IHaskell/Eval/Evaluate.hs @@ -150,7 +150,8 @@ initializeImports = do imports <- mapM parseImportDecl $ globalImports ++ displayImports setContext $ map IIDecl $ implicitPrelude : imports - -- | Give a value for the `it` variable. initializeItVariable :: Interpreter () +-- | Give a value for the `it` variable. +initializeItVariable :: Interpreter () initializeItVariable = -- This is required due to the way we handle `it` in the wrapper -- statements - if it doesn't exist, the first statement will fail. diff --git a/IHaskell/Eval/Parser.hs b/IHaskell/Eval/Parser.hs index 84a60fe8..fba512e2 100644 --- a/IHaskell/Eval/Parser.hs +++ b/IHaskell/Eval/Parser.hs @@ -43,7 +43,7 @@ type ColumnNumber = Int type ErrMsg = String -- | A location in an input string. -data StringLoc = Loc LineNumber ColumnNumber deriving Show +data StringLoc = Loc LineNumber ColumnNumber deriving (Show, Eq) -- | A block of code to be evaluated. -- Each block contains a single element - one declaration, statement, @@ -58,7 +58,7 @@ data CodeBlock | Directive DirectiveType String -- ^ An IHaskell directive. | Module String -- ^ A full Haskell module, to be compiled and loaded. | ParseError StringLoc ErrMsg -- ^ An error indicating that parsing the code block failed. - deriving Show + deriving (Show, Eq) -- | Directive types. Each directive is associated with a string in the -- directive code block. @@ -68,93 +68,17 @@ data DirectiveType | SetExtension -- ^ Enable or disable an extension via ':extension' (or prefixes) | HelpForSet -- ^ Provide useful info if people try ':set'. | GetHelp -- ^ General help via ':?' or ':help'. - deriving Show + deriving (Show, Eq) -- | Output from running a parser. data ParseOutput a = Failure ErrMsg StringLoc -- ^ Parser failed with given error message and location. | Success a (String, String) -- ^ Parser succeeded with an output. - -- Auxiliary strings say what part of the + deriving (Eq, Show) -- Auxiliary strings say what part of the -- input string was used and what -- part is remaining. --- $setup --- >>> import GHC --- >>> import GHC.Paths --- >>> import IHaskell.Eval.Parser --- >>> let ghc = runGhc (Just libdir) --- >>> let test = ghc . parseString - --- $extendedParserTests --- --- >>> test "" --- [] --- --- >>> test "3\nlet x = expr" --- [Expression "3",Statement "let x = expr"] --- --- >>> test "let x = 3 in x + 3" --- [Expression "let x = 3 in x + 3"] --- --- >>> test "data X = Y Int" --- [Declaration "data X = Y Int"] --- --- >>> test "3\n:t expr" --- [Expression "3",Directive GetType "expr"] --- --- >>> test "y <- print 'no'" --- [Statement "y <- print 'no'"] --- --- >>> test "y <- do print 'no'\nlet x = expr" --- [Statement "y <- do { print 'no' }",Statement "let x = expr"] --- --- >>> test "y <- do print 'no'\nlet x = expr\nexpression" --- [Statement "y <- do { print 'no' }",Statement "let x = expr",Expression "expression"] --- --- >>> test "print yes\nprint no" --- [Expression "print yes",Expression "print no"] --- --- >>> test "fun [] = 10" --- [Declaration "fun [] = 10"] --- --- >>> test "fun [] = 10\nprint 'h'" --- [Declaration "fun [] = 10",Expression "print 'h'"] --- --- >>> test "fun (x:xs) = 100" --- [Declaration "fun (x : xs) = 100"] --- --- >>> test "fun [] = 10\nfun (x:xs) = 100" --- [Declaration "fun [] = 10\nfun (x : xs) = 100"] --- --- >>> test "fun :: [a] -> Int\nfun [] = 10\nfun (x:xs) = 100" --- [Declaration "fun :: [a] -> Int\nfun [] = 10\nfun (x : xs) = 100"] --- --- >>> test "module A where x = 3" --- [Module "module A where\nx = 3"] --- --- >>> test "module B (x) where x = 3" --- [Module "module B (\n x\n ) where\nx = 3"] --- --- >>> test "let x = 3 in" --- [ParseError (Loc 1 13) "parse error (possibly incorrect indentation or mismatched brackets)"] --- --- >>> test "data X = 3" --- [ParseError (Loc 1 10) "Illegal literal in type (use -XDataKinds to enable): 3"] - - -- | Parse a string into code blocks. --- --- >>> test "let x = 3" --- [Statement "let x = 3"] --- --- >>> test ":type hello\n:in goodbye" --- [Directive GetType "hello",Directive GetInfo "goodbye"] --- --- >>> test "import Data.Monoid" --- [Import "import Data.Monoid"] --- --- >>> test "3 + 5" --- [Expression "3 + 5"] parseString :: GhcMonad m => String -> m [CodeBlock] parseString codeString = do -- Try to parse this as a single module. @@ -304,15 +228,6 @@ joinFunctions [] = [] -- | Parse a directive of the form :directiveName. --- --- >>> parseDirective ":ty hello" 0 --- Directive GetType "hello" --- --- >>> parseDirective ":inf goodbye" 0 --- Directive GetInfo "goodbye" --- --- >>> parseDirective ":nope goodbye" 11 --- ParseError (Loc 11 1) "Unknown directive: 'nope'." parseDirective :: String -- ^ Directive string. -> Int -- ^ Line number at which the directive appears. -> CodeBlock -- ^ Directive code block or a parse error. @@ -374,15 +289,6 @@ runParser flags parser str = -- | Split a string at a given line and column. The column is included in -- the second part of the split. --- --- >>> splitAtLoc 2 3 "abc\ndefghi\nxyz\n123" --- ("abc\nde","fghi\nxyz\n123") --- --- >>> splitAtLoc 2 1 "abc" --- ("abc","") --- --- >>> splitAtLoc 2 1 "abc\nhello" --- ("abc\n","hello") splitAtLoc :: LineNumber -> ColumnNumber -> String -> (String, String) splitAtLoc line col string = if line > length (lines string) @@ -400,15 +306,6 @@ splitAtLoc line col string = -- A chunk is a line and all lines immediately following that are indented -- beyond the indentation of the first line. This parses Haskell layout -- rules properly, and allows using multiline expressions via indentation. --- --- >>> layoutChunks "a string" --- ["a string"] --- --- >>> layoutChunks "a\n string" --- ["a\n string"] --- --- >>> layoutChunks "a\n string\nextra" --- ["a\n string","extra"] layoutChunks :: String -> [String] layoutChunks string = layoutLines (lines string) where @@ -456,19 +353,6 @@ dropComments = removeOneLineComments . removeMultilineComments -- | Parse a module and return the name declared in the 'module X where' -- line. That line is required, and if it does not exist, this will error. -- Names with periods in them are returned piece y piece. --- --- >>> ghc $ getModuleName "module A where\nx = 3" --- ["A"] --- --- >>> ghc $ getModuleName "module A.B.C where x = 3" --- ["A","B","C"] --- --- >>> ghc $ getModuleName "module A.B.C ( x ) where x = 3" --- ["A","B","C"] --- --- >>> ghc $ getModuleName "x = 3" --- *** Exception: Module parsing failed. --- getModuleName :: GhcMonad m => String -> m [String] getModuleName moduleSrc = do flags <- getSessionDynFlags diff --git a/IHaskell/IPython.hs b/IHaskell/IPython.hs index c6cac9f0..35ecae1a 100644 --- a/IHaskell/IPython.hs +++ b/IHaskell/IPython.hs @@ -22,10 +22,6 @@ import qualified System.IO.Strict as StrictIO import qualified IHaskell.Config as Config --- $setup --- >>> import ClassyPrelude --- >>> import IHaskell.IPython - -- | Run IPython with any arguments. ipython :: Bool -- ^ Whether to suppress output. -> [Text] -- ^ IPython command line arguments. @@ -52,9 +48,6 @@ ipythonVersion = shelly $ do return (major, minor, patch) -- | Parse an IPython version string into a list of integers. --- --- >>> parseVersion `map` ["2.0.0-dev", "2.0.0-alpha", "12.5.10"] --- [[2,0,0],[2,0,0],[12,5,10]] parseVersion :: String -> [Int] parseVersion versionStr = map read' $ split "." versionStr where read' x = case reads x of diff --git a/rundoctests.hs b/rundoctests.hs deleted file mode 100644 index 40e78945..00000000 --- a/rundoctests.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -import System.Process -import Test.DocTest -import System.Environment -import Data.String.Utils - --- | tests that all the >>> comments are followed by correct output. Easiest is to --- --- > cabal test --- --- or --- --- > runghc examples/rundoctests.hs --- --- or --- --- > runghc examples/rundoctests.hs Data/HList/File1.hs Data/HList/File2.hs --- --- you need Cabal >= 1.18 since that's around when cabal repl got added. -main :: IO () -main = do - -- Get files to run on. - args <- getArgs - - -- Get flags via cabal repl. - let cabalCmds = unlines [":show packages", ":show language"] - cabalOpts = ["repl","--ghc-options","-v0 -w"] - options <- readProcess "cabal" cabalOpts cabalCmds - let extraFlags = ["-fobject-code", "-XNoImplicitPrelude"] - flags = words (unlines $ filter (startswith "-" . strip) $ lines options) ++ extraFlags - - let files = case args of - [] -> ["Main.hs"] - _ -> args - putStrLn "Testing:\n--------" - mapM_ putStrLn files - putStr "\n" - - doctest $ "-i.": "-idist/build/autogen": - "-optP-include": - "-optPdist/build/autogen/cabal_macros.h" : - "-Idist/build/autogen" : "-w": - files ++ flags