Merge pull request #1413 from alanz/robust-tests

Robust tests

Author: alanz

.circleci/config.yml

@@ -26,6 +26,10 @@ defaults: &defaults
           - stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "stack-build.txt" }}
           - stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "resolver.txt" }}
 
+    # - run:
+    #     name: Stack upgrade
+    #     command: stack upgrade
+
     - run:
         name: Stack setup
         command: stack -j 2 --stack-yaml=${STACK_FILE} setup

app/MainHie.hs

@@ -119,6 +119,8 @@ run opts = do
   logm $  "Run entered for HIE(" ++ progName ++ ") " ++ version
   d <- getCurrentDirectory
   logm $ "Current directory:" ++ d
+  args <- getArgs
+  logm $ "args:" ++ show args
 
   let vomitOptions = defaultOptions { boLogging = BlVomit}
   let defaultOpts = if optGhcModVomit opts then vomitOptions else defaultOptions

test/functional/CompletionSpec.hs

@@ -16,7 +16,7 @@ spec :: Spec
 spec = describe "completions" $ do
   it "works" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
     let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put"
     _ <- applyEdit doc te
@@ -38,7 +38,7 @@ spec = describe "completions" $ do
 
   it "completes imports" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
     let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M"
     _ <- applyEdit doc te
@@ -52,7 +52,7 @@ spec = describe "completions" $ do
 
   it "completes qualified imports" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
     let te = TextEdit (Range (Position 2 17) (Position 1 25)) "Dat"
     _ <- applyEdit doc te
@@ -66,7 +66,7 @@ spec = describe "completions" $ do
 
   it "completes language extensions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
     let te = TextEdit (Range (Position 0 24) (Position 0 31)) ""
     _ <- applyEdit doc te
@@ -79,7 +79,7 @@ spec = describe "completions" $ do
 
   it "completes pragmas" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
     let te = TextEdit (Range (Position 0 4) (Position 0 34)) ""
     _ <- applyEdit doc te
@@ -94,7 +94,7 @@ spec = describe "completions" $ do
 
   it "completes pragmas no close" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
     let te = TextEdit (Range (Position 0 4) (Position 0 24)) ""
     _ <- applyEdit doc te
@@ -109,7 +109,7 @@ spec = describe "completions" $ do
 
   it "completes options pragma" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
     let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS"
     _ <- applyEdit doc te
@@ -127,7 +127,7 @@ spec = describe "completions" $ do
   it "completes ghc options pragma values" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
 
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
     let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red  #-}\n"
     _ <- applyEdit doc te
@@ -144,14 +144,14 @@ spec = describe "completions" $ do
 
   it "completes with no prefix" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
     compls <- getCompletions doc (Position 5 7)
     liftIO $ filter ((== "!!") . (^. label)) compls `shouldNotSatisfy` null
 
   -- See https://github.com/haskell/haskell-ide-engine/issues/903
   it "strips compiler generated stuff from completions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "DupRecFields.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
     let te = TextEdit (Range (Position 5 0) (Position 5 2)) "acc"
     _ <- applyEdit doc te
@@ -167,15 +167,15 @@ spec = describe "completions" $ do
   describe "contexts" $ do
     it "only provides type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Context.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
       compls <- getCompletions doc (Position 2 17)
       liftIO $ do
         compls `shouldContainCompl` "Integer"
         compls `shouldNotContainCompl` "interact"
 
     it "only provides type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Context.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
       compls <- getCompletions doc (Position 3 9)
       liftIO $ do
         compls `shouldContainCompl` "abs"
@@ -184,7 +184,7 @@ spec = describe "completions" $ do
     -- This currently fails if it takes too long to typecheck the module
     -- it "completes qualified type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     --   doc <- openDoc "Context.hs" "haskell"
-    --   _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      -- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
     --   let te = TextEdit (Range (Position 2 17) (Position 2 17)) " -> Conc."
     --   _ <- applyEdit doc te
     --   compls <- getCompletions doc (Position 2 26)
@@ -195,7 +195,7 @@ spec = describe "completions" $ do
 
   it "have implicit foralls on basic polymorphic types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
     let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id"
     _ <- applyEdit doc te
     compls <- getCompletions doc (Position 5 9)
@@ -207,7 +207,7 @@ spec = describe "completions" $ do
 
   it "have implicit foralls with multiple type variables" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
-    _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
     let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip"
     _ <- applyEdit doc te
     compls <- getCompletions doc (Position 5 11)
@@ -220,7 +220,7 @@ spec = describe "completions" $ do
   describe "snippets" $ do
     it "work for argumentless constructors" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Completion.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
       let te = TextEdit (Range (Position 5 7) (Position 5 24)) "Nothing"
       _ <- applyEdit doc te
@@ -233,7 +233,7 @@ spec = describe "completions" $ do
 
     it "work for polymorphic types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Completion.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
       let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold"
       _ <- applyEdit doc te
@@ -250,7 +250,7 @@ spec = describe "completions" $ do
 
     it "work for complex types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Completion.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
       let te = TextEdit (Range (Position 5 7) (Position 5 24)) "mapM"
       _ <- applyEdit doc te
@@ -267,7 +267,7 @@ spec = describe "completions" $ do
 
     it "work for infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Completion.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
       let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte"
       _ <- applyEdit doc te
@@ -282,7 +282,7 @@ spec = describe "completions" $ do
 
     it "work for infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Completion.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
       let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`"
       _ <- applyEdit doc te
@@ -297,7 +297,7 @@ spec = describe "completions" $ do
 
     it "work for qualified infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Completion.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
       let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe"
       _ <- applyEdit doc te
@@ -312,7 +312,7 @@ spec = describe "completions" $ do
 
     it "work for qualified infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Completion.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
       let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`"
       _ <- applyEdit doc te
@@ -328,7 +328,7 @@ spec = describe "completions" $ do
 
     it "respects lsp configuration" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Completion.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
       let config = object ["languageServerHaskell" .= (object ["completionSnippetsOn" .= False])]
 
@@ -338,7 +338,7 @@ spec = describe "completions" $ do
 
     it "respects client capabilities" $ runSession hieCommand noSnippetsCaps "test/testdata/completion" $ do
       doc <- openDoc "Completion.hs" "haskell"
-      _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
+      _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
 
       checkNoSnippets doc
   where

test/functional/DiagnosticsSpec.hs

@@ -2,6 +2,7 @@
 
 module DiagnosticsSpec where
 
+import Control.Applicative.Combinators
 import           Control.Lens hiding (List)
 import           Control.Monad.IO.Class
 import           Data.Aeson (toJSON)
@@ -87,7 +88,7 @@ spec = describe "diagnostics providers" $ do
 
         let te = TextEdit (Range (Position 0 0) (Position 0 13)) ""
         _ <- applyEdit doc te
-        noDiagnostics
+        skipManyTill loggingNotification noDiagnostics
 
         sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
         diags2 <- waitForDiagnostics

test/functional/HighlightSpec.hs

@@ -12,7 +12,7 @@ spec :: Spec
 spec = describe "highlight" $
   it "works" $ runSession hieCommand fullCaps "test/testdata" $ do
     doc <- openDoc "Highlight.hs" "haskell"
-    _ <- skipManyTill loggingNotification $ count 2 noDiagnostics
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
     highlights <- getHighlights doc (Position 2 2)
     liftIO $ do
       let hls =

test/functional/HoverSpec.hs

@@ -15,7 +15,7 @@ spec :: Spec
 spec = describe "hover" $
   it "works" $ runSession hieCommand fullCaps "test/testdata" $ do
     doc <- openDoc "Hover.hs" "haskell"
-    _ <- skipManyTill loggingNotification $ count 2 noDiagnostics
+    _ <- count 2 $ skipManyTill loggingNotification noDiagnostics
     Just h <- getHover doc (Position 1 19)
     liftIO $ do
       h ^. range `shouldBe` Just (Range (Position 1 16) (Position 1 19))

test/functional/ProgressSpec.hs

@@ -32,28 +32,29 @@ spec = describe "window/progress" $ do
         startNotification ^. L.params . L.title `shouldBe` "Typechecking ApplyRefact2.hs"
         startNotification ^. L.params . L.id `shouldBe` "0"
 
-      doneNotification <- message :: Session ProgressDoneNotification
+      doneNotification <- skipManyTill loggingNotification (message :: Session ProgressDoneNotification)
       liftIO $ doneNotification ^. L.params . L.id `shouldBe` "0"
 
       -- the ghc-mod diagnostics
-      _ <- publishDiagnosticsNotification
+      _ <- skipManyTill loggingNotification publishDiagnosticsNotification
 
       -- Test incrementing ids
       sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
 
       -- hlint notifications
-      _ <- publishDiagnosticsNotification
+      _ <- skipManyTill loggingNotification publishDiagnosticsNotification
 
-      startNotification' <- message :: Session ProgressStartNotification
+      startNotification' <- skipManyTill loggingNotification (message :: Session ProgressStartNotification)
       liftIO $ do
         startNotification' ^. L.params . L.title `shouldBe` "Typechecking ApplyRefact2.hs"
         startNotification' ^. L.params . L.id `shouldBe` "1"
 
-      doneNotification' <- message :: Session ProgressDoneNotification
+      doneNotification' <- skipManyTill loggingNotification (message :: Session ProgressDoneNotification)
       liftIO $ doneNotification' ^. L.params . L.id `shouldBe` "1"
 
       -- the ghc-mod diagnostics
-      const () <$> publishDiagnosticsNotification
+      const () <$> skipManyTill loggingNotification publishDiagnosticsNotification
+
   it "sends indefinite progress notifications with liquid" $
     -- Testing that Liquid Haskell sends progress notifications
     runSession hieCommand progressCaps "test/testdata" $ do
@@ -62,13 +63,13 @@ spec = describe "window/progress" $ do
       skipMany loggingNotification
 
       -- Initial hlint notifications
-      _ <- publishDiagnosticsNotification
+      _ <- skipManyTill loggingNotification publishDiagnosticsNotification
 
       _ <- message :: Session ProgressStartNotification
       _ <- message :: Session ProgressDoneNotification
 
       -- the ghc-mod diagnostics
-      _ <- publishDiagnosticsNotification
+      _ <- skipManyTill loggingNotification publishDiagnosticsNotification
 
       -- Enable liquid haskell plugin
       let config = def { liquidOn  = True, hlintOn = False }
@@ -78,7 +79,7 @@ spec = describe "window/progress" $ do
       sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
 
       -- hlint notifications
-      _ <- publishDiagnosticsNotification
+      _ <- skipManyTill loggingNotification publishDiagnosticsNotification
 
       let startPred (NotProgressStart m) =
             m ^. L.params . L.title == "Running Liquid Haskell on Evens.hs"
@@ -92,4 +93,4 @@ spec = describe "window/progress" $ do
       return ()
 
 progressCaps :: ClientCapabilities
-progressCaps = fullCaps { _window = Just (WindowClientCapabilities (Just True)) }
+progressCaps = fullCaps { _window = Just (WindowClientCapabilities (Just True)) }

test/testdata/addPackageTest/cabal-exe/AddPackage.hs

@@ -1,2 +1,3 @@
 import Data.Text
-foo = pack "I'm a Text"
+foo = pack "I'm a Text"
+main = putStrLn "hello"

test/unit/PackagePluginSpec.hs

@@ -47,15 +47,15 @@ packageSpec = do
         let fp = testdata </> cabal
         packageType <- findPackageType fp
         packageType `shouldBe` CabalPackage "add-package-test.cabal"
-    it "Find no project description if none is present " $ do
+    it "Find no project description if none is present" $ do
       let fp = cwd </> testdata </> "invalid"
       packageType <- findPackageType fp
       packageType `shouldBe` NoPackage
     it "Throws exception if path is invalid" $ do
       let fp = testdata </> "unknownPath"
       findPackageType fp `shouldThrow` anyIOException
   describe "Add the package to the correct file" $ do
-    it "Add package to .cabal to executable component"
+    it "Adds package to .cabal to executable component"
       $ withCurrentDirectory (testdata </> "cabal-exe")
       $ do
           let
@@ -167,7 +167,7 @@ packageSpec = do
           testCommand testPlugins act "package" "add" args res
 
 
-    it "Add package to package.yaml to executable component"
+    it "Adds package to package.yaml to executable component"
       $ withCurrentDirectory (testdata </> "hpack-exe")
       $ do
           let

test/utils/TestUtils.hs

@@ -136,7 +136,7 @@ ghcVersion = GHCPre84
 stackYaml :: FilePath
 stackYaml =
 #if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,5,0)))
-  "stack.yaml"
+  "stack-8.6.5.yaml"
 #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,4,0)))
   "stack-8.6.4.yaml"
 #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,3,0)))