Skip to content
This repository has been archived by the owner on Oct 7, 2020. It is now read-only.

Robust tests #1413

Merged
merged 5 commits into from
Oct 16, 2019
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions .circleci/config.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions app/MainHie.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
48 changes: 24 additions & 24 deletions test/functional/CompletionSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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"
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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])]

Expand All @@ -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
Expand Down
3 changes: 2 additions & 1 deletion test/functional/DiagnosticsSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion test/functional/HighlightSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
2 changes: 1 addition & 1 deletion test/functional/HoverSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
21 changes: 11 additions & 10 deletions test/functional/ProgressSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 }
Expand All @@ -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"
Expand All @@ -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)) }
3 changes: 2 additions & 1 deletion test/testdata/addPackageTest/cabal-exe/AddPackage.hs
Original file line number Diff line number Diff line change
@@ -1,2 +1,3 @@
import Data.Text
foo = pack "I'm a Text"
foo = pack "I'm a Text"
main = putStrLn "hello"
6 changes: 3 additions & 3 deletions test/unit/PackagePluginSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion test/utils/TestUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand Down