From bfdb4a1de7fe42ea4113bd921896755265f14386 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 13:53:59 -0400 Subject: [PATCH 1/2] Clean up specs with some implicit parameters. Test cases are a good use of `-XImplicitParams`, because often one finds oneself plumbing a bunch of parameters obtained from IO through a dozen layers of pure functions. Implicit parameters make this sort of passing significantly easier. Fixes #128. --- test/Analysis/Go/Spec.hs | 7 ++++--- test/Analysis/PHP/Spec.hs | 7 ++++--- test/Analysis/Python/Spec.hs | 8 +++++--- test/Analysis/Ruby/Spec.hs | 8 ++++---- test/Analysis/TypeScript/Spec.hs | 7 ++++--- test/Integration/Spec.hs | 4 ++-- test/Spec.hs | 35 ++++++++++++++++---------------- 7 files changed, 41 insertions(+), 35 deletions(-) diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index 42e0c7a875..6510f52cf6 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ImplicitParams #-} {-# OPTIONS_GHC -O0 #-} module Analysis.Go.Spec (spec) where @@ -6,8 +7,8 @@ import qualified Data.Language as Language import SpecHelpers -spec :: TaskSession -> Spec -spec session = parallel $ do +spec :: (?session :: TaskSession) => Spec +spec = parallel $ do describe "Go" $ do it "imports and wildcard imports" $ do (scopeGraph, (heap, res)) <- evaluate ["main.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"] @@ -32,4 +33,4 @@ spec session = parallel $ do where fixtures = "test/fixtures/go/analysis/" evaluate = evalGoProject . map (fixtures <>) - evalGoProject = testEvaluating <=< evaluateProject' session (Proxy :: Proxy 'Language.Go) goParser + evalGoProject = testEvaluating <=< evaluateProject' ?session (Proxy :: Proxy 'Language.Go) goParser diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index 950c14d905..ac1e096cdc 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ImplicitParams #-} {-# OPTIONS_GHC -O0 #-} module Analysis.PHP.Spec (spec) where @@ -7,8 +8,8 @@ import qualified Data.Language as Language import SpecHelpers -spec :: TaskSession -> Spec -spec session = parallel $ do +spec :: (?session :: TaskSession) => Spec +spec = parallel $ do describe "PHP" $ do xit "evaluates include and require" $ do (scopeGraph, (heap, res)) <- evaluate ["main.php", "foo.php", "bar.php"] @@ -44,4 +45,4 @@ spec session = parallel $ do where fixtures = "test/fixtures/php/analysis/" evaluate = evalPHPProject . map (fixtures <>) - evalPHPProject = testEvaluating <=< evaluateProject' session (Proxy :: Proxy 'Language.PHP) phpParser + evalPHPProject = testEvaluating <=< evaluateProject' ?session (Proxy :: Proxy 'Language.PHP) phpParser diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index 6e8c270003..ca4261d245 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ImplicitParams #-} + module Analysis.Python.Spec (spec) where import qualified Data.Abstract.ModuleTable as ModuleTable @@ -7,8 +9,8 @@ import qualified Data.Language as Language import SpecHelpers -spec :: TaskSession -> Spec -spec session = parallel $ do +spec :: (?session :: TaskSession) => Spec +spec = parallel $ do describe "Python" $ do it "imports" $ do (scopeGraph, (heap, res)) <- evaluate ["main.py", "a.py", "b/__init__.py", "b/c.py"] @@ -70,4 +72,4 @@ spec session = parallel $ do where fixtures = "test/fixtures/python/analysis/" evaluate = evalPythonProject . map (fixtures <>) - evalPythonProject = testEvaluating <=< evaluateProject' session (Proxy :: Proxy 'Language.Python) pythonParser + evalPythonProject = testEvaluating <=< evaluateProject' ?session (Proxy :: Proxy 'Language.Python) pythonParser diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 69aed61ce1..e2c4cac4d5 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -O0 #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ImplicitParams, TupleSections #-} module Analysis.Ruby.Spec (spec) where import Control.Abstract (Declaration (..), ScopeError (..)) @@ -14,8 +14,8 @@ import Data.Sum import SpecHelpers -spec :: TaskSession -> Spec -spec session = parallel $ do +spec :: (?session :: TaskSession) => Spec +spec = parallel $ do describe "Ruby" $ do it "evaluates require_relative" $ do (scopeGraph, (heap, res)) <- evaluate ["main.rb", "foo.rb"] @@ -101,4 +101,4 @@ spec session = parallel $ do where fixtures = "test/fixtures/ruby/analysis/" evaluate = evalRubyProject . map (fixtures <>) - evalRubyProject = testEvaluating <=< evaluateProject' session (Proxy :: Proxy 'Language.Ruby) rubyParser + evalRubyProject = testEvaluating <=< evaluateProject' ?session (Proxy :: Proxy 'Language.Ruby) rubyParser diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index 4a86bf9965..da7ebb636c 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ImplicitParams #-} {-# OPTIONS_GHC -O0 #-} module Analysis.TypeScript.Spec (spec) where @@ -21,8 +22,8 @@ import Data.Text (pack) import qualified Language.TypeScript.Assignment as TypeScript import SpecHelpers -spec :: TaskSession -> Spec -spec session = parallel $ do +spec :: (?session :: TaskSession) => Spec +spec = parallel $ do describe "TypeScript" $ do it "qualified export from" $ do (scopeGraph, (heap, res)) <- evaluate ["main6.ts", "baz.ts", "foo.ts"] @@ -181,7 +182,7 @@ spec session = parallel $ do where fixtures = "test/fixtures/typescript/analysis/" evaluate = evalTypeScriptProject . map (fixtures <>) - evalTypeScriptProject = testEvaluating <=< (evaluateProject' session (Proxy :: Proxy 'Language.TypeScript) typescriptParser) + evalTypeScriptProject = testEvaluating <=< (evaluateProject' ?session (Proxy :: Proxy 'Language.TypeScript) typescriptParser) type TypeScriptTerm = Quieterm (Sum TypeScript.Syntax) Location type TypeScriptEvalError = BaseError (EvalError TypeScriptTerm Precise (Concrete.Value TypeScriptTerm Precise)) diff --git a/test/Integration/Spec.hs b/test/Integration/Spec.hs index e9167630a7..2d0fcdee7f 100644 --- a/test/Integration/Spec.hs +++ b/test/Integration/Spec.hs @@ -17,8 +17,8 @@ import Test.Tasty.Golden languages :: [FilePath] languages = ["go", "javascript", "json", "python", "ruby", "typescript", "tsx"] -spec :: TaskSession -> TestTree -spec config = let ?session = config in testGroup "Integration (golden tests)" $ fmap testsForLanguage languages +spec :: (?session :: TaskSession) => TestTree +spec = testGroup "Integration (golden tests)" $ fmap testsForLanguage languages testsForLanguage :: (?session :: TaskSession) => FilePath -> TestTree testsForLanguage language = do diff --git a/test/Spec.hs b/test/Spec.hs index 5220b29f9d..7330d2ed64 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ImplicitParams #-} + module Main where import qualified Analysis.Go.Spec @@ -40,19 +42,18 @@ import Test.Hspec import Test.Tasty as Tasty import Test.Tasty.Hspec as Tasty -tests :: TaskSession -> [TestTree] -tests session = - [ Integration.Spec.spec session +tests :: (?session :: TaskSession) => [TestTree] +tests = + [ Integration.Spec.spec , Semantic.CLI.Spec.spec ] -- We can't bring this out of the IO monad until we divest -- from hspec, since testSpec operates in IO. -allTests :: TaskSession -> IO TestTree -allTests session = do - let nativeSpecs = tests session - asTastySpecs <- Tasty.testSpecs $ legacySpecs session - let allSpecs = nativeSpecs <> asTastySpecs +allTests :: (?session :: TaskSession) => IO TestTree +allTests = do + asTastySpecs <- Tasty.testSpecs legacySpecs + let allSpecs = tests <> asTastySpecs pure . Tasty.localOption Tasty.Success $ testGroup "semantic" allSpecs -- If you're writing new test modules, please don't add to this @@ -61,15 +62,15 @@ allTests session = do -- documentation: "hspec and tasty serve similar purposes; consider -- using one or the other.") Instead, create a new TestTree value -- in your spec module and add it to the above 'tests' list. -legacySpecs :: TaskSession -> Spec -legacySpecs args = do +legacySpecs :: (?session :: TaskSession) => Spec +legacySpecs = do describe "Semantic.Stat" Semantic.Stat.Spec.spec parallel $ do - describe "Analysis.Go" (Analysis.Go.Spec.spec args) - describe "Analysis.PHP" (Analysis.PHP.Spec.spec args) - describe "Analysis.Python" (Analysis.Python.Spec.spec args) - describe "Analysis.Ruby" (Analysis.Ruby.Spec.spec args) - describe "Analysis.TypeScript" (Analysis.TypeScript.Spec.spec args) + describe "Analysis.Go" Analysis.Go.Spec.spec + describe "Analysis.PHP" Analysis.PHP.Spec.spec + describe "Analysis.Python" Analysis.Python.Spec.spec + describe "Analysis.Ruby" Analysis.Ruby.Spec.spec + describe "Analysis.TypeScript" Analysis.TypeScript.Spec.spec describe "Assigning.Assignment" Assigning.Assignment.Spec.spec describe "Control.Abstract.Evaluator" Control.Abstract.Evaluator.Spec.spec describe "Data.Diff" Data.Diff.Spec.spec @@ -101,6 +102,6 @@ legacySpecs args = do main :: IO () main = do withOptions defaultOptions { optionsLogLevel = Nothing } $ \ config logger statter -> - let session = TaskSession config "-" False logger statter - in allTests session >>= defaultMain + let ?session = TaskSession config "-" False logger statter + in allTests >>= defaultMain From 9b0cae0975998106e68a97003010881d99e2cb01 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 13:59:32 -0400 Subject: [PATCH 2/2] Use verbose output when downloading hackage snapshot. --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 5dbd7eb182..77dad2ae16 100644 --- a/.travis.yml +++ b/.travis.yml @@ -28,7 +28,7 @@ before_install: - cabal --version install: -- cabal new-update hackage.haskell.org +- cabal new-update -v hackage.haskell.org - cabal new-configure --enable-tests --write-ghc-environment-files=always - cabal new-build --only-dependencies -j