From 7c6617d307988df22225fadc49eb748105b80818 Mon Sep 17 00:00:00 2001 From: Andrew Gibiansky Date: Sun, 18 May 2014 15:44:23 -0700 Subject: [PATCH] Revived test suite. Works with separate compilation, not cabal test though. --- ihaskell.cabal | 15 ++++++++---- notebooks/Test.ipynb | 52 +++++++++++++++++----------------------- src/Hspec.hs | 56 +++++++++++++++++++++++--------------------- 3 files changed, 62 insertions(+), 61 deletions(-) diff --git a/ihaskell.cabal b/ihaskell.cabal index 67419993..66bf1d55 100644 --- a/ihaskell.cabal +++ b/ihaskell.cabal @@ -155,8 +155,8 @@ Test-Suite hspec Main-Is: Hspec.hs default-language: Haskell2010 build-depends: - base ==4.6.*, aeson >=0.6 && < 0.8, + base ==4.6.*, base64-bytestring >=1.0, bytestring >=0.10, cereal >=0.3, @@ -168,8 +168,8 @@ Test-Suite hspec filepath -any, ghc ==7.6.*, ghc-parser >=0.1.1, - ghci-lib >=0.1, ghc-paths ==0.1.*, + ghci-lib >=0.1, haskeline -any, here ==1.2.*, hlint ==1.8.61, @@ -182,16 +182,23 @@ Test-Suite hspec parsec -any, process >=1.1, random >=1.0, - setenv -any, shelly ==1.5.*, split >= 0.2, + stm -any, strict >=0.3, system-argv0 -any, system-filepath -any, tar -any, + text >=0.11, transformers -any, unix >= 2.6, - utf8-string -any + unordered-containers -any, + utf8-string -any, + uuid >=1.3, + vector -any, + zeromq4-haskell >=0.1, + setenv ==0.1.* + default-extensions: DoAndIfThenElse diff --git a/notebooks/Test.ipynb b/notebooks/Test.ipynb index 05d38416..099eee8d 100644 --- a/notebooks/Test.ipynb +++ b/notebooks/Test.ipynb @@ -36,31 +36,10 @@ "cell_type": "code", "collapsed": false, "input": [ - "import System.Directory\n", - "getDirectoryContents \".\"" - ], - "language": "python", - "metadata": { - "hidden": false - }, - "outputs": [ - { - "metadata": {}, - "output_type": "display_data", - "text": [ - "[\".\",\"..\",\".hdevtools.sock\",\"blog\",\"experiments\",\"hackathon\",\"haskell-course-preludes\",\"haskell-style-guide\",\"ihaskell\",\"ihaskell-app\",\"linal\",\"notes\",\"slinky.nb\",\"tasha\"]" - ] - } - ], - "prompt_number": 9 - }, - { - "cell_type": "code", - "collapsed": false, - "input": [ - ":!cd code\n", - ":!pwd\n", - "setCurrentDirectory \"code\"" + ":ext QuasiQuotes\n", + "_ <- [myQQ| blah\n", + " blah\n", + " blah |]" ], "language": "python", "metadata": { @@ -69,23 +48,36 @@ "outputs": [ { "html": [ - "No such directory: 'code'" + "Not in scope: `myQQ'" ], "metadata": {}, "output_type": "display_data", "text": [ - "No such directory: 'code'" + "Not in scope: `myQQ'" ] - }, + } + ], + "prompt_number": 2 + }, + { + "cell_type": "code", + "collapsed": false, + "input": [ + ":!cd ..\n", + ":!pwd" + ], + "language": "python", + "metadata": {}, + "outputs": [ { "metadata": {}, "output_type": "display_data", "text": [ - "/Users/silver/code" + "/Users/silver" ] } ], - "prompt_number": 8 + "prompt_number": 3 }, { "cell_type": "code", diff --git a/src/Hspec.hs b/src/Hspec.hs index 669d1305..5015b67f 100644 --- a/src/Hspec.hs +++ b/src/Hspec.hs @@ -12,6 +12,7 @@ import System.Directory import Shelly (Sh, shelly, cmd, (), toTextIgnore, cd, withTmpDir, mkdir_p, touchfile) import qualified Shelly +import Control.Applicative ((<$>)) import Filesystem.Path.CurrentOS (encodeString) import System.SetEnv (setEnv) import Data.String.Here @@ -33,6 +34,8 @@ import Test.Hspec import Test.Hspec.HUnit import Test.HUnit (assertBool, assertFailure) +traceShowId x = traceShow x x + doGhc = runGhc (Just libdir) parses str = do @@ -50,7 +53,7 @@ eval string = do pagerAccum <- newIORef [] let publish evalResult = case evalResult of IntermediateResult {} -> return () - FinalResult outs page -> do + FinalResult outs page [] -> do modifyIORef outputAccum (outs :) modifyIORef pagerAccum (page :) @@ -78,7 +81,7 @@ becomes string expected = evaluationComparing comparison string expectationFailure $ "Expected result to have " ++ show (length expected) ++ " results. Got " ++ show results - forM_ (zip results expected) $ \(Display result, expected) -> + forM_ (zip results expected) $ \(ManyDisplay [Display result], expected) -> case extractPlain result of "" -> expectationFailure $ "No plain-text output in " ++ show result ++ "\nExpected: " ++ expected str -> str `shouldBe` expected @@ -99,8 +102,7 @@ completes string expected = completionTarget newString cursorloc `shouldBe` expe where (newString, cursorloc) = readCompletePrompt string completionEvent :: String -> Interpreter (String, [String]) -completionEvent string = do - complete newString cursorloc +completionEvent string = complete newString cursorloc where (newString, cursorloc) = case elemIndex '*' string of Nothing -> error "Expected cursor written as '*'." Just idx -> (replace "*" "" string, idx) @@ -111,11 +113,11 @@ completionEventInDirectory string shouldHaveCompletionsInDirectory :: String -> [String] -> IO () -shouldHaveCompletionsInDirectory string expected - = do (matched, completions) <- completionEventInDirectory string - let existsInCompletion = (`elem` completions) - unmatched = filter (not . existsInCompletion) expected - expected `shouldBeAmong` completions +shouldHaveCompletionsInDirectory string expected = do + (matched, completions) <- completionEventInDirectory string + let existsInCompletion = (`elem` completions) + unmatched = filter (not . existsInCompletion) expected + expected `shouldBeAmong` completions completionHas string expected = do (matched, completions) <- doGhc $ do initCompleter @@ -133,6 +135,7 @@ initCompleter = do imports <- mapM parseImportDecl ["import Prelude", "import qualified Control.Monad", "import qualified Data.List as List", + "import IHaskell.Display", "import Data.Maybe as Maybe"] setContext $ map IIDecl imports @@ -147,8 +150,7 @@ inDirectory dirs files action = shelly $ withTmpDir $ \dirPath -> mapM_ mkdir_p dirs mapM_ touchfile files liftIO $ doGhc $ wrap (encodeString dirPath) (action dirPath) - where noPublish = const $ return () - cdEvent path = Eval.evaluate defaultKernelState (":! cd " ++ path) noPublish + where cdEvent path = liftIO $ setCurrentDirectory path --Eval.evaluate defaultKernelState (":! cd " ++ path) noPublish wrap :: FilePath -> Interpreter a -> Interpreter a wrap path action = do initCompleter @@ -223,7 +225,7 @@ completionTests = do it "properly completes haskell file paths on :load directive" $ let loading xs = ":load " ++ encodeString xs - paths xs = map encodeString xs + paths = map encodeString in do loading ("dir" "file*") `shouldHaveCompletionsInDirectory` paths ["dir" "file2.hs", "dir" "file2.lhs"] @@ -238,24 +240,27 @@ completionTests = do , "./" "file1.hs" , "./" "file1.lhs"] - it "provides path completions on empty shell cmds " $ do - ":! cd *" `shouldHaveCompletionsInDirectory` (map encodeString ["" "dir/" - , "" "file1.hs" - , "" "file1.lhs"]) + it "provides path completions on empty shell cmds " $ + ":! cd *" `shouldHaveCompletionsInDirectory` map encodeString ["" "dir/" + , "" "file1.hs" + , "" "file1.lhs"] + let withHsHome action = withHsDirectory $ \dirPath-> do + home <- shelly $ Shelly.get_env_text "HOME" + setHomeEvent dirPath + result <- action + setHomeEvent $ Shelly.fromText home + return result + setHomeEvent path = liftIO $ setEnv "HOME" (encodeString path) it "correctly interprets ~ as the environment HOME variable" $ let shouldHaveCompletions :: String -> [String] -> IO () shouldHaveCompletions string expected = do - (matched, completions) - <- withHsDirectory $ \dirPath -> - do setHomeEvent dirPath - completionEvent string + (matched, completions) <- withHsHome $ completionEvent string let existsInCompletion = (`elem` completions) unmatched = filter (not . existsInCompletion) expected expected `shouldBeAmong` completions - setHomeEvent path = liftIO $ setEnv "HOME" (encodeString path) in do ":! cd ~/*" `shouldHaveCompletions` ["~/dir/"] ":! ~/*" `shouldHaveCompletions` ["~/dir/"] @@ -264,11 +269,7 @@ completionTests = do let shouldHaveMatchingText :: String -> String -> IO () shouldHaveMatchingText string expected = do - matchText - <- withHsDirectory $ \dirPath -> - do setHomeEvent dirPath - (matchText, _) <- uncurry complete (readCompletePrompt string) - return matchText + matchText <- withHsHome $ fst <$> uncurry complete (readCompletePrompt string) matchText `shouldBe` expected setHomeEvent path = liftIO $ setEnv "HOME" (encodeString path) @@ -333,7 +334,8 @@ evalTests = do "import Control.Monad (when)" `becomes` [] it "evaluates directives" $ do - ":typ 3" `becomes` ["forall a. Num a => a"] + ":typ 3" `becomes` ["3 :: forall a. Num a => a"] + ":k Maybe" `becomes` ["Maybe :: * -> *"] ":in String" `pages` ["type String = [Char] \t-- Defined in `GHC.Base'"] parserTests = do