From 2754e26e9a8d8ab6af7ba9bc12419e06d0fd0f41 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 11:04:42 -0400 Subject: [PATCH 01/15] Port over Integration.hs. --- test/Integration/Spec.hs | 53 +++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 28 deletions(-) diff --git a/test/Integration/Spec.hs b/test/Integration/Spec.hs index bc1036289..ee2f2ac9e 100644 --- a/test/Integration/Spec.hs +++ b/test/Integration/Spec.hs @@ -1,36 +1,48 @@ +{-# LANGUAGE ImplicitParams, LambdaCase, NamedFieldPuns #-} module Integration.Spec (spec) where import Control.Exception (throw) import Data.Foldable (find, traverse_, for_) import Data.List (union, concat, transpose) import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL import System.FilePath.Glob import System.FilePath.Posix +import System.IO.Unsafe import SpecHelpers +import Test.Tasty +import Test.Tasty.Golden +import Test.Tasty.HUnit + languages :: [FilePath] languages = ["go", "javascript", "json", "python", "ruby", "typescript", "tsx"] -spec :: TaskSession -> Spec -spec config = parallel $ do - for_ languages $ \language -> do - let dir = "test/fixtures" language "corpus" - it (language <> " corpus exists") $ examples dir `shouldNotReturn` [] - describe (language <> " corpus") $ runTestsIn dir [] +spec :: TaskSession -> TestTree +spec config = let ?session = config in testGroup "Integration (golden tests)" $ fmap testsForLanguage languages - where - runTestsIn :: FilePath -> [(FilePath, String)] -> SpecWith () - runTestsIn directory pending = do - examples <- runIO $ examples directory - traverse_ (runTest pending) examples - runTest pending ParseExample{..} = it ("parses " <> file) $ maybe (testParse config file parseOutput) pendingWith (lookup parseOutput pending) - runTest pending DiffExample{..} = it ("diffs " <> diffOutput) $ maybe (testDiff config (Both fileA fileB) diffOutput) pendingWith (lookup diffOutput pending) +testsForLanguage :: (?session :: TaskSession) => FilePath -> TestTree +testsForLanguage language = do + let dir = "test/fixtures" language "corpus" + let items = unsafePerformIO (examples dir) + testGroup language (fmap testForExample items) data Example = DiffExample { fileA :: FilePath, fileB :: FilePath, diffOutput :: FilePath } | ParseExample { file :: FilePath, parseOutput :: FilePath } deriving (Eq, Show) +testForExample :: (?session :: TaskSession) => Example -> TestTree +testForExample = \case + DiffExample{fileA, fileB, diffOutput} -> + goldenVsStringDiff + ("diffs " <> diffOutput) + (\ref new -> ["git", "diff", ref, new]) + diffOutput + (BL.fromStrict <$> diffFilePaths ?session (Both fileA fileB)) + ParseExample{file, parseOutput} -> testCase ("parses " <> file) (pure ()) + + -- | Return all the examples from the given directory. Examples are expected to -- | have the form: -- | @@ -81,18 +93,3 @@ examples directory = do -- | Given a test name like "foo.A.js", return "foo". normalizeName :: FilePath -> FilePath normalizeName path = dropExtension $ dropExtension path - -testParse :: TaskSession -> FilePath -> FilePath -> Expectation -testParse session path expectedOutput = do - actual <- fmap verbatim <$> parseFilePath session path - case actual of - Left err -> throw err - Right actual -> do - expected <- verbatim <$> B.readFile expectedOutput - actual `shouldBe` expected - -testDiff :: TaskSession -> Both FilePath -> FilePath -> Expectation -testDiff config paths expectedOutput = do - actual <- verbatim <$> diffFilePaths config paths - expected <- verbatim <$> B.readFile expectedOutput - actual `shouldBe` expected From 99c4bb21f8856e28054676d257e089084dda3d4c Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 11:30:20 -0400 Subject: [PATCH 02/15] Overhaul test harnesses and add tasty bounds. --- cabal.project | 5 -- semantic.cabal | 9 ++- test/Data/Term/Spec.hs | 2 +- test/Diffing/Interpreter/Spec.hs | 2 +- test/Integration/Spec.hs | 9 ++- test/Spec.hs | 101 ++++++++++++++++++++----------- test/SpecHelpers.hs | 2 +- 7 files changed, 80 insertions(+), 50 deletions(-) diff --git a/cabal.project b/cabal.project index 5772f0815..e7b8e8637 100644 --- a/cabal.project +++ b/cabal.project @@ -14,8 +14,3 @@ source-repository-package type: git location: https://github.com/joshvera/proto3-wire.git tag: 84664e22f01beb67870368f1f88ada5d0ad01f56 - -source-repository-package - type: git - location: https://github.com/rewinfrey/hspec-expectations-pretty-diff - tag: 94af5871c24ba319f7f72fefa53c1a4d074c9a29 diff --git a/semantic.cabal b/semantic.cabal index 7ba07963b..79fc22ca7 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -274,7 +274,7 @@ library autogen-modules: Paths_semantic other-modules: Paths_semantic build-depends: base >= 4.12 && < 5 - , ansi-terminal ^>= 0.8.2 + , ansi-terminal >= 0.8.2 && <1 , array ^>= 0.5.3.0 , attoparsec ^>= 0.13.2.2 , cmark-gfm == 0.1.8 @@ -384,7 +384,10 @@ test-suite test , Glob , hspec >= 2.6 && <3 , hspec-core >= 2.6 && <3 - , hspec-expectations-pretty-diff ^>= 0.7.2.5 + , hspec-expectations ^>= 0.8.2 + , tasty ^>= 1.2.3 + , tasty-golden ^>= 2.3.2 + , tasty-hspec ^>= 1.1.5.1 , HUnit ^>= 1.6.0.0 , leancheck >= 0.8 && <1 , temporary @@ -400,7 +403,7 @@ test-suite parse-examples , Glob , hspec >= 2.4.1 , hspec-core - , hspec-expectations-pretty-diff + , hspec-expectations benchmark evaluation import: haskell, executable-flags diff --git a/test/Data/Term/Spec.hs b/test/Data/Term/Spec.hs index ec4cc3ddd..2c785547e 100644 --- a/test/Data/Term/Spec.hs +++ b/test/Data/Term/Spec.hs @@ -4,7 +4,7 @@ module Data.Term.Spec (spec) where import Data.Functor.Listable import Data.Term import Test.Hspec (Spec, describe, parallel) -import Test.Hspec.Expectations.Pretty +import Test.Hspec.Expectations import Test.Hspec.LeanCheck spec :: Spec diff --git a/test/Diffing/Interpreter/Spec.hs b/test/Diffing/Interpreter/Spec.hs index 04933af76..738a4fcaa 100644 --- a/test/Diffing/Interpreter/Spec.hs +++ b/test/Diffing/Interpreter/Spec.hs @@ -15,7 +15,7 @@ import Data.These import Diffing.Interpreter import qualified Data.Syntax as Syntax import Test.Hspec (Spec, describe, it, parallel) -import Test.Hspec.Expectations.Pretty +import Test.Hspec.Expectations import Test.Hspec.LeanCheck import Test.LeanCheck.Core import SpecHelpers () diff --git a/test/Integration/Spec.hs b/test/Integration/Spec.hs index ee2f2ac9e..f2c820325 100644 --- a/test/Integration/Spec.hs +++ b/test/Integration/Spec.hs @@ -14,7 +14,6 @@ import SpecHelpers import Test.Tasty import Test.Tasty.Golden -import Test.Tasty.HUnit languages :: [FilePath] languages = ["go", "javascript", "json", "python", "ruby", "typescript", "tsx"] @@ -27,6 +26,7 @@ testsForLanguage language = do let dir = "test/fixtures" language "corpus" let items = unsafePerformIO (examples dir) testGroup language (fmap testForExample items) +{-# NOINLINE testsForLanguage #-} data Example = DiffExample { fileA :: FilePath, fileB :: FilePath, diffOutput :: FilePath } | ParseExample { file :: FilePath, parseOutput :: FilePath } @@ -40,7 +40,12 @@ testForExample = \case (\ref new -> ["git", "diff", ref, new]) diffOutput (BL.fromStrict <$> diffFilePaths ?session (Both fileA fileB)) - ParseExample{file, parseOutput} -> testCase ("parses " <> file) (pure ()) + ParseExample{file, parseOutput} -> + goldenVsStringDiff + ("parses " <> parseOutput) + (\ref new -> ["git", "diff", ref, new]) + parseOutput + (parseFilePath ?session file >>= either throw (pure . BL.fromStrict)) -- | Return all the examples from the given directory. Examples are expected to diff --git a/test/Spec.hs b/test/Spec.hs index 3497d6bd0..0e4b82e76 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -37,43 +37,70 @@ import qualified Semantic.Stat.Spec import Semantic.Config (defaultOptions, optionsLogLevel) import Semantic.Task (withOptions, TaskSession(..)) import Test.Hspec +import Test.Tasty as Tasty +import Test.Tasty.Hspec as Tasty +import Test.Tasty.Options as Tasty + +tests :: TaskSession -> [TestTree] +tests session = + [ Integration.Spec.spec session + ] + +-- 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 + pure . Tasty.localOption Tasty.Success $ testGroup "semantic" allSpecs + +-- If you're writing new test modules, please don't add to this +-- stanza: it is only there to prevent massive rewrites, and is +-- converted into a Tasty TestTree in 'main'. (Quoth the tasty-hspec +-- documentation: "hspec and tasty serve similar purposes; consider +-- using one or the other.") Instead, +legacySpecs :: TaskSession -> Spec +legacySpecs args = 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 "Assigning.Assignment" Assigning.Assignment.Spec.spec + describe "Control.Abstract.Evaluator" Control.Abstract.Evaluator.Spec.spec + describe "Data.Diff" Data.Diff.Spec.spec + describe "Data.Graph" Data.Graph.Spec.spec + describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec + describe "Data.Abstract.Name" Data.Abstract.Name.Spec.spec + describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec + describe "Data.Range" Data.Range.Spec.spec + describe "Data.Scientific" Data.Scientific.Spec.spec + describe "Data.Semigroup.App" Data.Semigroup.App.Spec.spec + describe "Data.Source" Data.Source.Spec.spec + describe "Data.Term" Data.Term.Spec.spec + describe "Diffing.Algorithm.RWS" Diffing.Algorithm.RWS.Spec.spec + describe "Diffing.Algorithm.SES" Diffing.Algorithm.SES.Spec.spec + describe "Diffing.Interpreter" Diffing.Interpreter.Spec.spec + describe "Graphing.Calls" Graphing.Calls.Spec.spec + describe "Numeric" Numeric.Spec.spec + describe "Rendering.TOC" Rendering.TOC.Spec.spec + describe "Reprinting.Spec" Reprinting.Spec.spec + describe "Rewriting.Go" Rewriting.Go.Spec.spec + describe "Rewriting.JSON" Rewriting.JSON.Spec.spec + describe "Rewriting.Python" Rewriting.Python.Spec.spec + describe "Tags.Spec" Tags.Spec.spec + describe "Semantic" Semantic.Spec.spec + describe "Semantic.CLI" Semantic.CLI.Spec.spec + describe "Semantic.IO" Semantic.IO.Spec.spec + describe "Parsing" Parsing.Spec.spec + main :: IO () main = do - withOptions defaultOptions { optionsLogLevel = Nothing } $ \ config logger statter -> hspec $ do - let args = TaskSession config "-" False logger statter - 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 "Assigning.Assignment" Assigning.Assignment.Spec.spec - describe "Control.Abstract.Evaluator" Control.Abstract.Evaluator.Spec.spec - describe "Data.Diff" Data.Diff.Spec.spec - describe "Data.Graph" Data.Graph.Spec.spec - describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec - describe "Data.Abstract.Name" Data.Abstract.Name.Spec.spec - describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec - describe "Data.Range" Data.Range.Spec.spec - describe "Data.Scientific" Data.Scientific.Spec.spec - describe "Data.Semigroup.App" Data.Semigroup.App.Spec.spec - describe "Data.Source" Data.Source.Spec.spec - describe "Data.Term" Data.Term.Spec.spec - describe "Diffing.Algorithm.RWS" Diffing.Algorithm.RWS.Spec.spec - describe "Diffing.Algorithm.SES" Diffing.Algorithm.SES.Spec.spec - describe "Diffing.Interpreter" Diffing.Interpreter.Spec.spec - describe "Graphing.Calls" Graphing.Calls.Spec.spec - describe "Numeric" Numeric.Spec.spec - describe "Rendering.TOC" Rendering.TOC.Spec.spec - describe "Reprinting.Spec" Reprinting.Spec.spec - describe "Rewriting.Go" Rewriting.Go.Spec.spec - describe "Rewriting.JSON" Rewriting.JSON.Spec.spec - describe "Rewriting.Python" Rewriting.Python.Spec.spec - describe "Tags.Spec" Tags.Spec.spec - describe "Semantic" Semantic.Spec.spec - describe "Semantic.CLI" Semantic.CLI.Spec.spec - describe "Semantic.IO" Semantic.IO.Spec.spec - describe "Integration" (Integration.Spec.spec args) - describe "Parsing" Parsing.Spec.spec + withOptions defaultOptions { optionsLogLevel = Nothing } $ \ config logger statter -> + let session = TaskSession config "-" False logger statter + in allTests session >>= defaultMain + diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 992f3524e..7b480994c 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -71,7 +71,7 @@ import Data.Semigroup as X (Semigroup(..)) import Control.Monad as X import Test.Hspec as X (Spec, SpecWith, context, describe, it, xit, parallel, pendingWith, around, runIO) -import Test.Hspec.Expectations.Pretty as X +import Test.Hspec.Expectations as X import Test.Hspec.LeanCheck as X import Test.LeanCheck as X From 6a24b9c79395838ec7651de73810cc465efc109e Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 11:34:54 -0400 Subject: [PATCH 03/15] Fix whitespace changes in hash fixture. --- test/fixtures/json/corpus/hash.diffA-B.txt | 10 +++++----- test/fixtures/json/corpus/hash.diffB-A.txt | 6 +++--- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/test/fixtures/json/corpus/hash.diffA-B.txt b/test/fixtures/json/corpus/hash.diffA-B.txt index f9fa320ed..3c0b1eaab 100644 --- a/test/fixtures/json/corpus/hash.diffA-B.txt +++ b/test/fixtures/json/corpus/hash.diffA-B.txt @@ -1,7 +1,7 @@ (Hash - {-(KeyValue - {-(TextElement)-} - {-(Float)-})-} +{-(KeyValue + {-(TextElement)-} + {-(Float)-})-} (KeyValue (TextElement) (Float)) @@ -12,7 +12,7 @@ (KeyValue (TextElement) { (Float) - ->(Float)}) - {+(KeyValue + ->(Float) }) +{+(KeyValue {+(TextElement)+} {+(Float)+})+}) diff --git a/test/fixtures/json/corpus/hash.diffB-A.txt b/test/fixtures/json/corpus/hash.diffB-A.txt index 952d54b0d..4b8b4d151 100644 --- a/test/fixtures/json/corpus/hash.diffB-A.txt +++ b/test/fixtures/json/corpus/hash.diffB-A.txt @@ -7,12 +7,12 @@ (Float)) (KeyValue { (TextElement) - ->(TextElement)} + ->(TextElement) } (Float)) (KeyValue (TextElement) { (Float) - ->(Float)}) + ->(Float) }) {-(KeyValue {-(TextElement)-} - {-(Float)-})-}) \ No newline at end of file + {-(Float)-})-}) From 0292506ebdde2fed1e62955a03aa0f8e8be0dfdb Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 12:26:02 -0400 Subject: [PATCH 04/15] Account for occasional race conditions in testsForLanguage. Not sure where this is coming from, but we don't want the builders to get stuck. --- test/Integration/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Integration/Spec.hs b/test/Integration/Spec.hs index f2c820325..b9545ff4e 100644 --- a/test/Integration/Spec.hs +++ b/test/Integration/Spec.hs @@ -25,7 +25,7 @@ testsForLanguage :: (?session :: TaskSession) => FilePath -> TestTree testsForLanguage language = do let dir = "test/fixtures" language "corpus" let items = unsafePerformIO (examples dir) - testGroup language (fmap testForExample items) + localOption (mkTimeout 3000000) $ testGroup language $ fmap testForExample items {-# NOINLINE testsForLanguage #-} data Example = DiffExample { fileA :: FilePath, fileB :: FilePath, diffOutput :: FilePath } From acbacbe77966b3fb0a9e77bf61dbb424efac0da1 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 12:26:37 -0400 Subject: [PATCH 05/15] Use golden tests for the CLI. --- test/Semantic/CLI/Spec.hs | 55 ++++++++++++++++++++++++++------------- test/Spec.hs | 2 +- 2 files changed, 38 insertions(+), 19 deletions(-) diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index cfc46ea72..78b5b128e 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -4,33 +4,52 @@ import Control.Monad (when) import qualified Data.ByteString as B import Data.ByteString.Builder import Data.Foldable (for_) -import Semantic.Api hiding (File, Blob, BlobPair) +import Semantic.Api hiding (Blob, BlobPair, File) import Semantic.CLI import Semantic.IO import Semantic.Task import Serializing.Format +import System.Directory +import System.IO.Unsafe +import System.Process import SpecHelpers +import Test.Tasty +import Test.Tasty.Golden + +spec :: TestTree +spec = testGroup "Semantic.CLI" + [ testGroup "parseDiffBuilder" $ fmap testForDiffFixture diffFixtures + , testGroup "parseTermBuilder" $ fmap testForParseFixture parseFixtures + ] + +-- If you're investigating these tests and find this output hard to read +-- the `jd` CLI tool (https://github.com/josephburnett/jd) will print +-- a detailed summary of the differences between these JSON files. +renderDiff :: String -> String -> [String] +renderDiff ref new = unsafePerformIO $ do + useJD <- (isExtensionOf ".json" ref &&) <$> fmap isJust (findExecutable "jd") + pure $ if useJD + then ["jd", "-set", ref, new] + else ["git", "diff", ref, new] +{-# NOINLINE renderDiff #-} -spec :: Spec -spec = parallel $ do - describe "parseDiffBuilder" $ - for_ diffFixtures $ \ (diffRenderer, runDiff, files, expected) -> - it ("renders to " <> diffRenderer <> " with files " <> show files) $ do - output <- runTaskOrDie $ readBlobPairs (Right files) >>= runDiff - runBuilder output `shouldBe'` expected +-- PT TODO: reduce duplication - describe "parseTermBuilder" $ - for_ parseFixtures $ \ (format, runParse, files, expected) -> - it ("renders to " <> format <> " with files " <> show files) $ do - output <- runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse - runBuilder output `shouldBe'` expected - where - shouldBe' actual' expectedFile = do - let actual = verbatim actual' - expected <- verbatim <$> B.readFile expectedFile - actual `shouldBe` expected +testForDiffFixture (diffRenderer, runDiff, files, expected) = + goldenVsStringDiff + ("renders to " <> diffRenderer) + renderDiff + expected + (fmap toLazyByteString . runTaskOrDie $ readBlobPairs (Right files) >>= runDiff) + +testForParseFixture (format, runParse, files, expected) = + goldenVsStringDiff + ("renders to " <> format) + renderDiff + expected + (fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse) parseFixtures :: [(String, [Blob] -> TaskEff Builder, [File], FilePath)] parseFixtures = diff --git a/test/Spec.hs b/test/Spec.hs index 0e4b82e76..e37ab66b7 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -44,6 +44,7 @@ import Test.Tasty.Options as Tasty tests :: TaskSession -> [TestTree] tests session = [ Integration.Spec.spec session + , Semantic.CLI.Spec.spec ] -- We can't bring this out of the IO monad until we divest @@ -93,7 +94,6 @@ legacySpecs args = do describe "Rewriting.Python" Rewriting.Python.Spec.spec describe "Tags.Spec" Tags.Spec.spec describe "Semantic" Semantic.Spec.spec - describe "Semantic.CLI" Semantic.CLI.Spec.spec describe "Semantic.IO" Semantic.IO.Spec.spec describe "Parsing" Parsing.Spec.spec From 3363eccfdff6b54c3ba1d418280965827a364710 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 12:29:11 -0400 Subject: [PATCH 06/15] Better comments and test labels. --- test/Semantic/CLI/Spec.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index 78b5b128e..6b0e9e3df 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -23,9 +23,11 @@ spec = testGroup "Semantic.CLI" , testGroup "parseTermBuilder" $ fmap testForParseFixture parseFixtures ] --- If you're investigating these tests and find this output hard to read --- the `jd` CLI tool (https://github.com/josephburnett/jd) will print --- a detailed summary of the differences between these JSON files. +-- We provide this function to the golden tests so as to have better +-- output when diffing JSON outputs. If you're investigating these +-- tests and find this output hard to read, install the `jd` CLI tool +-- (https://github.com/josephburnett/jd), which will print a detailed +-- summary of the differences between these JSON files. renderDiff :: String -> String -> [String] renderDiff ref new = unsafePerformIO $ do useJD <- (isExtensionOf ".json" ref &&) <$> fmap isJust (findExecutable "jd") @@ -34,19 +36,16 @@ renderDiff ref new = unsafePerformIO $ do else ["git", "diff", ref, new] {-# NOINLINE renderDiff #-} - --- PT TODO: reduce duplication - testForDiffFixture (diffRenderer, runDiff, files, expected) = goldenVsStringDiff - ("renders to " <> diffRenderer) + ("diff fixture renders to " <> diffRenderer <> " " <> show files) renderDiff expected (fmap toLazyByteString . runTaskOrDie $ readBlobPairs (Right files) >>= runDiff) testForParseFixture (format, runParse, files, expected) = goldenVsStringDiff - ("renders to " <> format) + ("diff fixture renders to " <> format <> " " <> show files) renderDiff expected (fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse) From 11442cf772bf0ea16e6fbbc26b74c2f44c4f0316 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 12:37:40 -0400 Subject: [PATCH 07/15] Add more bounds. --- semantic.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/semantic.cabal b/semantic.cabal index 79fc22ca7..0777ff5f7 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -381,7 +381,7 @@ test-suite test , Test.Hspec.LeanCheck build-depends: semantic , tree-sitter-json - , Glob + , Glob ^>= 0.10.0 , hspec >= 2.6 && <3 , hspec-core >= 2.6 && <3 , hspec-expectations ^>= 0.8.2 @@ -390,7 +390,7 @@ test-suite test , tasty-hspec ^>= 1.1.5.1 , HUnit ^>= 1.6.0.0 , leancheck >= 0.8 && <1 - , temporary + , temporary ^>= 1.3 if flag(release) ghc-options: -dynamic @@ -401,7 +401,7 @@ test-suite parse-examples main-is: Examples.hs build-depends: semantic , Glob - , hspec >= 2.4.1 + , hspec , hspec-core , hspec-expectations @@ -412,7 +412,7 @@ benchmark evaluation main-is: Main.hs ghc-options: -static build-depends: base - , criterion + , criterion ^>= 1.5 , semantic source-repository head From 14bbf6856b844c31df6a8a5642214ca2d543d80e Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 12:46:30 -0400 Subject: [PATCH 08/15] Kill `verbatim`, since we have more principled golden tests now. --- test/SpecHelpers.hs | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 7b480994c..3a27a15b3 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -10,8 +10,6 @@ module SpecHelpers , runTaskOrDie , TaskSession(..) , testEvaluating -, verbatim -, Verbatim(..) , toList , Config , LogQueue @@ -195,17 +193,3 @@ lookupDeclaration name (currentScope, currentFrame) heap scopeGraph = do path <- ScopeGraph.lookupScopePath name currentScope scopeGraph frameAddress <- Heap.lookupFrameAddress path currentFrame heap toList <$> Heap.getSlotValue (Slot frameAddress (Heap.pathPosition path)) heap - -newtype Verbatim = Verbatim ByteString - deriving (Eq) - -instance Show Verbatim where - showsPrec _ (Verbatim byteString) = (T.unpack (T.decodeUtf8 byteString) ++) - -verbatim :: ByteString -> Verbatim -verbatim = Verbatim . stripWhitespace - where - stripWhitespace :: ByteString -> ByteString - stripWhitespace = B.foldl' go B.empty - where go acc x | x `B.elem` " \t\n" = acc - | otherwise = B.snoc acc x From b8cb9d1bfa652c08cea2f7673b753dbb616c9cb2 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 12:52:11 -0400 Subject: [PATCH 09/15] Remove unused imports. --- semantic.cabal | 1 + test/Analysis/Go/Spec.hs | 2 -- test/Analysis/PHP/Spec.hs | 3 --- test/Analysis/Python/Spec.hs | 2 -- test/Analysis/Ruby/Spec.hs | 3 +-- test/Analysis/TypeScript/Spec.hs | 5 ----- test/Reprinting/Spec.hs | 6 ------ test/Rewriting/Go/Spec.hs | 2 -- test/Rewriting/JSON/Spec.hs | 13 +++++-------- test/Rewriting/Python/Spec.hs | 4 ---- test/Semantic/CLI/Spec.hs | 6 ------ test/Semantic/Spec.hs | 2 -- test/SpecHelpers.hs | 8 -------- 13 files changed, 7 insertions(+), 50 deletions(-) diff --git a/semantic.cabal b/semantic.cabal index 0777ff5f7..2c7f67288 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -340,6 +340,7 @@ test-suite test import: haskell, dependencies, executable-flags type: exitcode-stdio-1.0 hs-source-dirs: test + ghc-options: -Wunused-imports main-is: Spec.hs other-modules: Analysis.Go.Spec , Analysis.PHP.Spec diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index a750f46bb..42e0c7a87 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -1,10 +1,8 @@ {-# OPTIONS_GHC -O0 #-} module Analysis.Go.Spec (spec) where -import Data.Abstract.Evaluatable (EvalError(..)) import qualified Data.Abstract.ModuleTable as ModuleTable import qualified Data.Language as Language -import qualified Language.Go.Assignment as Go import SpecHelpers diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index de74db45c..950c14d90 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -1,12 +1,9 @@ {-# OPTIONS_GHC -O0 #-} module Analysis.PHP.Spec (spec) where -import Control.Abstract -import Data.Abstract.Evaluatable (EvalError (..)) import qualified Data.Abstract.ModuleTable as ModuleTable import qualified Data.Abstract.Value.Concrete as Value import qualified Data.Language as Language -import qualified Language.PHP.Assignment as PHP import SpecHelpers diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index a87e9e8bf..6e8c27000 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -1,9 +1,7 @@ module Analysis.Python.Spec (spec) where -import Data.Abstract.Evaluatable (EvalError(..)) import qualified Data.Abstract.ModuleTable as ModuleTable import Data.Abstract.Value.Concrete -import qualified Language.Python.Assignment as Python import qualified Data.Language as Language import SpecHelpers diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 1efe60f8a..69aed61ce 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -2,14 +2,13 @@ {-# LANGUAGE TupleSections #-} module Analysis.Ruby.Spec (spec) where -import Control.Abstract (Declaration (..), ScopeError (..), runDeref) +import Control.Abstract (Declaration (..), ScopeError (..)) import Control.Effect.Resumable (SomeError (..)) import Data.Abstract.Evaluatable import qualified Data.Abstract.ModuleTable as ModuleTable import Data.Abstract.Number as Number import Data.Abstract.Value.Concrete as Value import qualified Data.Language as Language -import Data.List.NonEmpty (NonEmpty (..)) import Data.Sum import SpecHelpers diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index 75169a1d4..4a86bf996 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -5,20 +5,15 @@ module Analysis.TypeScript.Spec (spec) where import Data.Syntax.Statement (StatementBlock(..)) import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..)) import Control.Abstract.ScopeGraph hiding (AccessControl(..)) -import Control.Abstract.Value as Value hiding (String, Unit) -import Control.Arrow ((&&&)) import Data.Abstract.Evaluatable import qualified Data.Abstract.Heap as Heap import Data.Abstract.Module (ModuleInfo (..)) import qualified Data.Abstract.ModuleTable as ModuleTable import Data.Abstract.Number as Number import Data.Abstract.Package (PackageInfo (..)) -import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Abstract.Value.Concrete as Concrete import qualified Data.Language as Language -import qualified Data.List.NonEmpty as NonEmpty import Data.Location -import qualified Data.Map.Internal as Map import Data.Quieterm import Data.Scientific (scientific) import Data.Sum diff --git a/test/Reprinting/Spec.hs b/test/Reprinting/Spec.hs index b138e6c4c..bbbbc3576 100644 --- a/test/Reprinting/Spec.hs +++ b/test/Reprinting/Spec.hs @@ -5,23 +5,17 @@ module Reprinting.Spec where import SpecHelpers hiding (inject, project) import Data.Foldable -import Data.Functor.Foldable (cata, embed) import qualified Data.Machine as Machine import Control.Rewriting hiding (context) -import Data.Algebra -import Data.Blob import qualified Data.Language as Language import Data.Reprinting.Scope import Data.Reprinting.Token import Data.Sum import qualified Data.Syntax.Literal as Literal import Language.JSON.PrettyPrint -import Language.Python.PrettyPrint -import Language.Ruby.PrettyPrint import Reprinting.Pipeline import Reprinting.Tokenize -import Semantic.IO increaseNumbers :: (Literal.Float :< fs, Apply Functor fs) => Rule (Term (Sum fs) History) increaseNumbers = do diff --git a/test/Rewriting/Go/Spec.hs b/test/Rewriting/Go/Spec.hs index 54a9bcb45..c7796a209 100644 --- a/test/Rewriting/Go/Spec.hs +++ b/test/Rewriting/Go/Spec.hs @@ -3,10 +3,8 @@ module Rewriting.Go.Spec (spec) where import Control.Rewriting -import Data.Abstract.Module import Data.List import Data.Sum -import qualified Data.Syntax.Declaration as Decl import qualified Data.Syntax.Literal as Lit import qualified Data.Syntax.Statement as Stmt import Data.Text (Text) diff --git a/test/Rewriting/JSON/Spec.hs b/test/Rewriting/JSON/Spec.hs index 284f03523..fef994ba5 100644 --- a/test/Rewriting/JSON/Spec.hs +++ b/test/Rewriting/JSON/Spec.hs @@ -1,21 +1,18 @@ -{-# LANGUAGE TypeOperators, TypeFamilies #-} +{-# LANGUAGE TypeFamilies, TypeOperators #-} module Rewriting.JSON.Spec (spec) where -import Prelude hiding (id, (.)) - +import Prelude hiding (id, (.)) import SpecHelpers -import qualified Data.ByteString as B -import Data.Either -import Data.Text (Text) - import Control.Category import Control.Rewriting as Rewriting +import qualified Data.ByteString as B import Data.History as History import qualified Data.Source as Source import Data.Sum import qualified Data.Syntax.Literal as Literal +import Data.Text (Text) import Language.JSON.PrettyPrint import Reprinting.Pipeline @@ -48,7 +45,7 @@ spec = describe "rewriting" $ do refactored <- runIO $ do json <- parseFile jsonParser path - let result = rewrite @Maybe (History.mark Unmodified json) (topDownAny onTrees) + let result = rewrite @Maybe (History.mark Unmodified json) (topDownAny onTrees) maybe (fail "rewrite failed") pure result it "should add keys to JSON values" $ do diff --git a/test/Rewriting/Python/Spec.hs b/test/Rewriting/Python/Spec.hs index 6a9a9ea94..623cecfa4 100644 --- a/test/Rewriting/Python/Spec.hs +++ b/test/Rewriting/Python/Spec.hs @@ -4,13 +4,9 @@ module Rewriting.Python.Spec (spec) where import Control.Arrow import Control.Rewriting -import Data.Abstract.Module -import Data.List import Data.Sum import qualified Data.Syntax.Declaration as Decl import qualified Data.Syntax.Literal as Lit -import qualified Data.Syntax.Statement as Stmt -import Data.Text (Text) import SpecHelpers -- This gets the Text contents of all integers diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index 6b0e9e3df..923d3afce 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -1,17 +1,11 @@ module Semantic.CLI.Spec (spec) where -import Control.Monad (when) -import qualified Data.ByteString as B import Data.ByteString.Builder -import Data.Foldable (for_) import Semantic.Api hiding (Blob, BlobPair, File) -import Semantic.CLI -import Semantic.IO import Semantic.Task import Serializing.Format import System.Directory import System.IO.Unsafe -import System.Process import SpecHelpers import Test.Tasty diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs index 76b53738a..ba06a3dbd 100644 --- a/test/Semantic/Spec.hs +++ b/test/Semantic/Spec.hs @@ -1,7 +1,5 @@ module Semantic.Spec (spec) where -import Data.Diff -import Data.Patch import Semantic.Api hiding (Blob) import Semantic.Git import System.Exit diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 3a27a15b3..b9f9a5801 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -23,7 +23,6 @@ import Control.Abstract hiding (lookupDeclaration) import Data.Abstract.ScopeGraph (EdgeLabel(..)) import qualified Data.Abstract.ScopeGraph as ScopeGraph import qualified Data.Abstract.Heap as Heap -import Control.Arrow ((&&&)) import Control.Effect.Trace as X (runTraceByIgnoring, runTraceByReturning) import Control.Monad ((>=>)) import Data.Traversable as X (for) @@ -34,7 +33,6 @@ import Data.Abstract.Module as X import Data.Abstract.ModuleTable as X hiding (lookup) import Data.Abstract.Name as X import Data.Abstract.Value.Concrete (Value(..), ValueError, runValueError) -import Data.Bifunctor (first) import Data.Blob as X import Data.Blob.IO as X import Data.ByteString.Builder (toLazyByteString) @@ -52,8 +50,6 @@ import Data.Span as X hiding (HasSpan(..)) import Data.String import Data.Sum import Data.Term as X -import qualified Data.Text as T -import qualified Data.Text.Encoding as T import Parsing.Parser as X import Semantic.Task as X hiding (parsePackage) import Semantic.Util as X @@ -73,10 +69,6 @@ import Test.Hspec.Expectations as X import Test.Hspec.LeanCheck as X import Test.LeanCheck as X -import qualified Data.ByteString as B -import qualified Data.Set as Set -import Data.Set (Set) -import qualified Semantic.IO as IO import Semantic.Config (Config(..), optionsLogLevel) import Semantic.Telemetry (LogQueue, StatQueue) import Semantic.Api hiding (File, Blob, BlobPair) From 6a1569519567c4e25a3b10c25aebaa008ea76c32 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 13:16:34 -0400 Subject: [PATCH 10/15] Even more unused imports. --- test/Control/Abstract/Evaluator/Spec.hs | 5 ----- test/Data/Abstract/Name/Spec.hs | 2 -- test/Graphing/Calls/Spec.hs | 4 ---- test/Integration/Spec.hs | 3 +-- test/Parsing/Spec.hs | 3 --- test/Rendering/TOC/Spec.hs | 3 --- test/Spec.hs | 1 - 7 files changed, 1 insertion(+), 20 deletions(-) diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 62735b0a9..88b98a786 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -8,19 +8,14 @@ import qualified Control.Abstract.Heap as Heap import Data.Abstract.Address.Precise as Precise import Data.Abstract.BaseError import Data.Abstract.Evaluatable -import Data.Abstract.FreeVariables import Data.Abstract.Module import qualified Data.Abstract.Number as Number import Data.Abstract.Package import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Abstract.Value.Concrete as Value -import Data.Algebra -import Data.Bifunctor (first) -import Data.Functor.Const import qualified Data.Language as Language import qualified Data.Map.Strict as Map import Data.Sum -import Data.Text (pack) import SpecHelpers hiding (reassociate) import System.IO.Unsafe (unsafePerformIO) diff --git a/test/Data/Abstract/Name/Spec.hs b/test/Data/Abstract/Name/Spec.hs index ab65902ff..972266b34 100644 --- a/test/Data/Abstract/Name/Spec.hs +++ b/test/Data/Abstract/Name/Spec.hs @@ -2,8 +2,6 @@ module Data.Abstract.Name.Spec where import SpecHelpers -import Data.Abstract.Name - spec :: Spec spec = describe "Data.Abstract.Name" $ it "should format anonymous names correctly" $ do diff --git a/test/Graphing/Calls/Spec.hs b/test/Graphing/Calls/Spec.hs index d5aa71dca..7f4342250 100644 --- a/test/Graphing/Calls/Spec.hs +++ b/test/Graphing/Calls/Spec.hs @@ -8,14 +8,10 @@ import SpecHelpers hiding (readFile) import Algebra.Graph import Data.List (uncons) -import Data.Abstract.Module import "semantic" Data.Graph (Graph (..), topologicalSort) import Data.Graph.ControlFlowVertex -import Data.Span import qualified Data.Language as Language -import Semantic.Config (defaultOptions) import Semantic.Graph -import Semantic.IO callGraphPythonProject paths = runTaskOrDie $ do let proxy = Proxy @'Language.Python diff --git a/test/Integration/Spec.hs b/test/Integration/Spec.hs index b9545ff4e..e9167630a 100644 --- a/test/Integration/Spec.hs +++ b/test/Integration/Spec.hs @@ -2,9 +2,8 @@ module Integration.Spec (spec) where import Control.Exception (throw) -import Data.Foldable (find, traverse_, for_) +import Data.Foldable (find) import Data.List (union, concat, transpose) -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import System.FilePath.Glob import System.FilePath.Posix diff --git a/test/Parsing/Spec.hs b/test/Parsing/Spec.hs index 591e1328a..d0e6ebc5c 100644 --- a/test/Parsing/Spec.hs +++ b/test/Parsing/Spec.hs @@ -1,6 +1,5 @@ module Parsing.Spec (spec) where -import Control.Effect import Data.AST import Data.Blob import Data.ByteString.Char8 (pack) @@ -9,9 +8,7 @@ import Data.Language import Data.Maybe import Data.Source import Parsing.TreeSitter -import Semantic.Config import SpecHelpers -import System.Timeout import TreeSitter.JSON (tree_sitter_json, Grammar) spec :: Spec diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index a811b6a0d..adadcd19b 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -10,20 +10,17 @@ import Data.Diff import Data.Functor.Classes import Data.Hashable.Lifted import Data.Patch -import Data.Range import Data.Location import Data.Span import Data.Sum import Data.Term import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) import Diffing.Algorithm hiding (Diff) import Diffing.Interpreter import Prelude import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration import Rendering.TOC -import Semantic.Config import Semantic.Api (diffSummaryBuilder) import Serializing.Format as Format diff --git a/test/Spec.hs b/test/Spec.hs index e37ab66b7..2e4b908b6 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -39,7 +39,6 @@ import Semantic.Task (withOptions, TaskSession(..)) import Test.Hspec import Test.Tasty as Tasty import Test.Tasty.Hspec as Tasty -import Test.Tasty.Options as Tasty tests :: TaskSession -> [TestTree] tests session = From 7d88f930cb2191d44b38761796cfa4ec864c9c92 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 13:27:34 -0400 Subject: [PATCH 11/15] Fix sentence fragment. --- test/Spec.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index 2e4b908b6..5220b29f9 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -59,7 +59,8 @@ allTests session = do -- stanza: it is only there to prevent massive rewrites, and is -- converted into a Tasty TestTree in 'main'. (Quoth the tasty-hspec -- documentation: "hspec and tasty serve similar purposes; consider --- using one or the other.") Instead, +-- 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 describe "Semantic.Stat" Semantic.Stat.Spec.spec From 2e84c636131bdea4298227cc5d9553fd7940634a Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 13:59:32 -0400 Subject: [PATCH 12/15] 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 5dbd7eb18..77dad2ae1 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 From 2795bc735777da587acc6667e8a4858e4cc4e082 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 14:50:18 -0400 Subject: [PATCH 13/15] somehow lost this -O0 --- test/Analysis/Python/Spec.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index 6e8c27000..b9b10fbbf 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -O0 #-} module Analysis.Python.Spec (spec) where import qualified Data.Abstract.ModuleTable as ModuleTable From a4652120a713bcfbc0a02a3e94e7a4db0bfa9a2f Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 16:40:28 -0400 Subject: [PATCH 14/15] Fix test cases for builders (which don't have jd). --- test/Semantic/IO/Spec.hs | 2 - test/fixtures/cli/diff-tree.json | 154 +---------------- test/fixtures/cli/diff-tree.toc.json | 27 +-- test/fixtures/cli/parse-tree-empty.json | 4 +- test/fixtures/cli/parse-tree.symbols.json | 27 +-- test/fixtures/cli/parse-trees.json | 197 +--------------------- 6 files changed, 5 insertions(+), 406 deletions(-) diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs index baef0f3a8..c57b30e5e 100644 --- a/test/Semantic/IO/Spec.hs +++ b/test/Semantic/IO/Spec.hs @@ -107,7 +107,5 @@ spec = parallel $ do where blobsFromFilePath path = do h <- openFileForReading path - putStrLn "got handle" blobs <- readBlobPairsFromHandle h - putStrLn "got blobs" pure blobs diff --git a/test/fixtures/cli/diff-tree.json b/test/fixtures/cli/diff-tree.json index 42e9aa642..a3d75848b 100644 --- a/test/fixtures/cli/diff-tree.json +++ b/test/fixtures/cli/diff-tree.json @@ -1,153 +1 @@ -{ - "diffs": [{ - "diff": { - "merge": { - "term": "Statements", - "statements": [{ - "merge": { - "term": "Method", - "methodAccessControl":"Public", - "methodBody": { - "merge": { - "children": [{ - "patch": { - "insert": { - "term": "Send", - "sourceRange": [13, 16], - "sendReceiver": null, - "sendBlock": null, - "sendArgs": [], - "sourceSpan": { - "start": [2, 3], - "end": [2, 6] - }, - "sendSelector": { - "patch": { - "insert": { - "term": "Identifier", - "name": "baz", - "sourceRange": [13, 16], - "sourceSpan": { - "start": [2, 3], - "end": [2, 6] - } - } - } - } - } - } - }], - "before": { - "sourceRange": [8, 11], - "sourceSpan": { - "start": [2, 1], - "end": [2, 4] - } - }, - "after": { - "sourceRange": [13, 16], - "sourceSpan": { - "start": [2, 3], - "end": [2, 6] - } - } - } - }, - "methodContext": [], - "methodName": { - "patch": { - "replace": [{ - "term": "Identifier", - "name": "foo", - "sourceRange": [4, 7], - "sourceSpan": { - "start": [1, 5], - "end": [1, 8] - } - }, { - "term": "Identifier", - "name": "bar", - "sourceRange": [4, 7], - "sourceSpan": { - "start": [1, 5], - "end": [1, 8] - } - }] - } - }, - "methodParameters": [{ - "patch": { - "insert": { - "term": "Identifier", - "name": "a", - "sourceRange": [8, 9], - "sourceSpan": { - "start": [1, 9], - "end": [1, 10] - } - } - } - }], - "methodReceiver": { - "merge": { - "term": "Empty", - "before": { - "sourceRange": [0, 0], - "sourceSpan": { - "start": [1, 1], - "end": [1, 1] - } - }, - "after": { - "sourceRange": [0, 0], - "sourceSpan": { - "start": [1, 1], - "end": [1, 1] - } - } - } - }, - "before": { - "sourceRange": [0, 11], - "sourceSpan": { - "start": [1, 1], - "end": [2, 4] - } - }, - "after": { - "sourceRange": [0, 20], - "sourceSpan": { - "start": [1, 1], - "end": [3, 4] - } - } - } - }], - "before": { - "sourceRange": [0, 12], - "sourceSpan": { - "start": [1, 1], - "end": [3, 1] - } - }, - "after": { - "sourceRange": [0, 21], - "sourceSpan": { - "start": [1, 1], - "end": [4, 1] - } - } - } - }, - "stat": { - "path": "test/fixtures/ruby/corpus/method-declaration.A.rb->test/fixtures/ruby/corpus/method-declaration.B.rb", - "replace": [{ - "path": "test/fixtures/ruby/corpus/method-declaration.A.rb", - "language": "Ruby" - }, { - "path": "test/fixtures/ruby/corpus/method-declaration.B.rb", - "language": "Ruby" - }] - } - }] -} +{"diffs":[{"diff":{"merge":{"term":"Statements","statements":[{"merge":{"term":"Method","methodAccessControl":"Public","methodBody":{"merge":{"children":[{"patch":{"insert":{"term":"Send","sourceRange":[13,16],"sendReceiver":null,"sendBlock":null,"sendArgs":[],"sourceSpan":{"start":[2,3],"end":[2,6]},"sendSelector":{"patch":{"insert":{"term":"Identifier","name":"baz","sourceRange":[13,16],"sourceSpan":{"start":[2,3],"end":[2,6]}}}}}}}],"before":{"sourceRange":[8,11],"sourceSpan":{"start":[2,1],"end":[2,4]}},"after":{"sourceRange":[13,16],"sourceSpan":{"start":[2,3],"end":[2,6]}}}},"methodContext":[],"methodName":{"patch":{"replace":[{"term":"Identifier","name":"foo","sourceRange":[4,7],"sourceSpan":{"start":[1,5],"end":[1,8]}},{"term":"Identifier","name":"bar","sourceRange":[4,7],"sourceSpan":{"start":[1,5],"end":[1,8]}}]}},"methodParameters":[{"patch":{"insert":{"term":"Identifier","name":"a","sourceRange":[8,9],"sourceSpan":{"start":[1,9],"end":[1,10]}}}}],"methodReceiver":{"merge":{"term":"Empty","before":{"sourceRange":[0,0],"sourceSpan":{"start":[1,1],"end":[1,1]}},"after":{"sourceRange":[0,0],"sourceSpan":{"start":[1,1],"end":[1,1]}}}},"before":{"sourceRange":[0,11],"sourceSpan":{"start":[1,1],"end":[2,4]}},"after":{"sourceRange":[0,20],"sourceSpan":{"start":[1,1],"end":[3,4]}}}}],"before":{"sourceRange":[0,12],"sourceSpan":{"start":[1,1],"end":[3,1]}},"after":{"sourceRange":[0,21],"sourceSpan":{"start":[1,1],"end":[4,1]}}}},"stat":{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb->test/fixtures/ruby/corpus/method-declaration.B.rb","replace":[{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb","language":"Ruby"},{"path":"test/fixtures/ruby/corpus/method-declaration.B.rb","language":"Ruby"}]}}]} diff --git a/test/fixtures/cli/diff-tree.toc.json b/test/fixtures/cli/diff-tree.toc.json index d23542239..f0e0a42e4 100644 --- a/test/fixtures/cli/diff-tree.toc.json +++ b/test/fixtures/cli/diff-tree.toc.json @@ -1,26 +1 @@ -{ - "files": [ - { - "path": "test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb", - "language": "Ruby", - "changes": [ - { - "category": "Method", - "term": "bar", - "span": - { - "start": - { - "line": 1, - "column": 1 - }, - "end": - { - "line": 3, - "column": 4 - } - }, - "changeType": "MODIFIED" - }] - }] -} +{"files":[{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb","language":"Ruby","changes":[{"category":"Method","term":"bar","span":{"start":{"line":1,"column":1},"end":{"line":3,"column":4}},"changeType":"MODIFIED"}]}]} diff --git a/test/fixtures/cli/parse-tree-empty.json b/test/fixtures/cli/parse-tree-empty.json index ec8e3347d..9cb7d5b7c 100644 --- a/test/fixtures/cli/parse-tree-empty.json +++ b/test/fixtures/cli/parse-tree-empty.json @@ -1,3 +1 @@ -{ - "trees": [] -} +{"trees":[]} diff --git a/test/fixtures/cli/parse-tree.symbols.json b/test/fixtures/cli/parse-tree.symbols.json index eb9282009..d605418e7 100644 --- a/test/fixtures/cli/parse-tree.symbols.json +++ b/test/fixtures/cli/parse-tree.symbols.json @@ -1,26 +1 @@ -{ - "files": [ - { - "path": "test/fixtures/ruby/corpus/method-declaration.A.rb", - "language": "Ruby", - "symbols": [ - { - "symbol": "foo", - "kind": "Method", - "line": "def foo", - "span": - { - "start": - { - "line": 1, - "column": 1 - }, - "end": - { - "line": 2, - "column": 4 - } - } - }] - }] -} +{"files":[{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb","language":"Ruby","symbols":[{"symbol":"foo","kind":"Method","line":"def foo","span":{"start":{"line":1,"column":1},"end":{"line":2,"column":4}}}]}]} diff --git a/test/fixtures/cli/parse-trees.json b/test/fixtures/cli/parse-trees.json index 3f91bf823..5fad80b6d 100644 --- a/test/fixtures/cli/parse-trees.json +++ b/test/fixtures/cli/parse-trees.json @@ -1,196 +1 @@ -{ - "trees": [{ - "tree": { - "term": "Statements", - "statements": [{ - "term": "LowPrecedenceAnd", - "lhs": { - "term": "Send", - "sendArgs": [], - "sendBlock": null, - "sendReceiver": null, - "sendSelector": { - "term": "Identifier", - "name": "foo", - "sourceRange": [0, 3], - "sourceSpan": { - "start": [1, 1], - "end": [1, 4] - } - }, - "sourceRange": [0, 3], - "sourceSpan": { - "start": [1, 1], - "end": [1, 4] - } - }, - "rhs": { - "term": "Send", - "sendArgs": [], - "sendBlock": null, - "sendReceiver": null, - "sendSelector": { - "term": "Identifier", - "name": "bar", - "sourceRange": [8, 11], - "sourceSpan": { - "start": [1, 9], - "end": [1, 12] - } - }, - "sourceRange": [8, 11], - "sourceSpan": { - "start": [1, 9], - "end": [1, 12] - } - }, - "sourceRange": [0, 11], - "sourceSpan": { - "start": [1, 1], - "end": [1, 12] - } - }], - "sourceRange": [0, 12], - "sourceSpan": { - "start": [1, 1], - "end": [2, 1] - } - }, - "path": "test/fixtures/ruby/corpus/and-or.A.rb", - "language": "Ruby" - }, { - "tree": { - "term": "Statements", - "statements": [{ - "term": "LowPrecedenceOr", - "lhs": { - "term": "Send", - "sendArgs": [], - "sendBlock": null, - "sendReceiver": null, - "sendSelector": { - "term": "Identifier", - "name": "foo", - "sourceRange": [0, 3], - "sourceSpan": { - "start": [1, 1], - "end": [1, 4] - } - }, - "sourceRange": [0, 3], - "sourceSpan": { - "start": [1, 1], - "end": [1, 4] - } - }, - "rhs": { - "term": "Send", - "sendArgs": [], - "sendBlock": null, - "sendReceiver": null, - "sendSelector": { - "term": "Identifier", - "name": "bar", - "sourceRange": [7, 10], - "sourceSpan": { - "start": [1, 8], - "end": [1, 11] - } - }, - "sourceRange": [7, 10], - "sourceSpan": { - "start": [1, 8], - "end": [1, 11] - } - }, - "sourceRange": [0, 10], - "sourceSpan": { - "start": [1, 1], - "end": [1, 11] - } - }, { - "term": "LowPrecedenceAnd", - "lhs": { - "term": "LowPrecedenceOr", - "lhs": { - "term": "Send", - "sendArgs": [], - "sendBlock": null, - "sendReceiver": null, - "sendSelector": { - "term": "Identifier", - "name": "a", - "sourceRange": [11, 12], - "sourceSpan": { - "start": [2, 1], - "end": [2, 2] - } - }, - "sourceRange": [11, 12], - "sourceSpan": { - "start": [2, 1], - "end": [2, 2] - } - }, - "rhs": { - "term": "Send", - "sendArgs": [], - "sendBlock": null, - "sendReceiver": null, - "sendSelector": { - "term": "Identifier", - "name": "b", - "sourceRange": [16, 17], - "sourceSpan": { - "start": [2, 6], - "end": [2, 7] - } - }, - "sourceRange": [16, 17], - "sourceSpan": { - "start": [2, 6], - "end": [2, 7] - } - }, - "sourceRange": [11, 17], - "sourceSpan": { - "start": [2, 1], - "end": [2, 7] - } - }, - "rhs": { - "term": "Send", - "sendArgs": [], - "sendBlock": null, - "sendReceiver": null, - "sendSelector": { - "term": "Identifier", - "name": "c", - "sourceRange": [22, 23], - "sourceSpan": { - "start": [2, 12], - "end": [2, 13] - } - }, - "sourceRange": [22, 23], - "sourceSpan": { - "start": [2, 12], - "end": [2, 13] - } - }, - "sourceRange": [11, 23], - "sourceSpan": { - "start": [2, 1], - "end": [2, 13] - } - }], - "sourceRange": [0, 24], - "sourceSpan": { - "start": [1, 1], - "end": [3, 1] - } - }, - "path": "test/fixtures/ruby/corpus/and-or.B.rb", - "language": "Ruby" - }] -} \ No newline at end of file +{"trees":[{"tree":{"term":"Statements","statements":[{"term":"LowPrecedenceAnd","lhs":{"term":"Send","sendArgs":[],"sendBlock":null,"sendReceiver":null,"sendSelector":{"term":"Identifier","name":"foo","sourceRange":[0,3],"sourceSpan":{"start":[1,1],"end":[1,4]}},"sourceRange":[0,3],"sourceSpan":{"start":[1,1],"end":[1,4]}},"rhs":{"term":"Send","sendArgs":[],"sendBlock":null,"sendReceiver":null,"sendSelector":{"term":"Identifier","name":"bar","sourceRange":[8,11],"sourceSpan":{"start":[1,9],"end":[1,12]}},"sourceRange":[8,11],"sourceSpan":{"start":[1,9],"end":[1,12]}},"sourceRange":[0,11],"sourceSpan":{"start":[1,1],"end":[1,12]}}],"sourceRange":[0,12],"sourceSpan":{"start":[1,1],"end":[2,1]}},"path":"test/fixtures/ruby/corpus/and-or.A.rb","language":"Ruby"},{"tree":{"term":"Statements","statements":[{"term":"LowPrecedenceOr","lhs":{"term":"Send","sendArgs":[],"sendBlock":null,"sendReceiver":null,"sendSelector":{"term":"Identifier","name":"foo","sourceRange":[0,3],"sourceSpan":{"start":[1,1],"end":[1,4]}},"sourceRange":[0,3],"sourceSpan":{"start":[1,1],"end":[1,4]}},"rhs":{"term":"Send","sendArgs":[],"sendBlock":null,"sendReceiver":null,"sendSelector":{"term":"Identifier","name":"bar","sourceRange":[7,10],"sourceSpan":{"start":[1,8],"end":[1,11]}},"sourceRange":[7,10],"sourceSpan":{"start":[1,8],"end":[1,11]}},"sourceRange":[0,10],"sourceSpan":{"start":[1,1],"end":[1,11]}},{"term":"LowPrecedenceAnd","lhs":{"term":"LowPrecedenceOr","lhs":{"term":"Send","sendArgs":[],"sendBlock":null,"sendReceiver":null,"sendSelector":{"term":"Identifier","name":"a","sourceRange":[11,12],"sourceSpan":{"start":[2,1],"end":[2,2]}},"sourceRange":[11,12],"sourceSpan":{"start":[2,1],"end":[2,2]}},"rhs":{"term":"Send","sendArgs":[],"sendBlock":null,"sendReceiver":null,"sendSelector":{"term":"Identifier","name":"b","sourceRange":[16,17],"sourceSpan":{"start":[2,6],"end":[2,7]}},"sourceRange":[16,17],"sourceSpan":{"start":[2,6],"end":[2,7]}},"sourceRange":[11,17],"sourceSpan":{"start":[2,1],"end":[2,7]}},"rhs":{"term":"Send","sendArgs":[],"sendBlock":null,"sendReceiver":null,"sendSelector":{"term":"Identifier","name":"c","sourceRange":[22,23],"sourceSpan":{"start":[2,12],"end":[2,13]}},"sourceRange":[22,23],"sourceSpan":{"start":[2,12],"end":[2,13]}},"sourceRange":[11,23],"sourceSpan":{"start":[2,1],"end":[2,13]}}],"sourceRange":[0,24],"sourceSpan":{"start":[1,1],"end":[3,1]}},"path":"test/fixtures/ruby/corpus/and-or.B.rb","language":"Ruby"}]} From d50c08152bc329f93421bf736798ecb0d3875585 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Jun 2019 16:43:52 -0400 Subject: [PATCH 15/15] forgot one last .json file --- test/fixtures/cli/diff-tree.json | 2 +- test/fixtures/cli/parse-tree.json | 63 +------------------------------ 2 files changed, 2 insertions(+), 63 deletions(-) diff --git a/test/fixtures/cli/diff-tree.json b/test/fixtures/cli/diff-tree.json index a3d75848b..d8c9bcfaf 100644 --- a/test/fixtures/cli/diff-tree.json +++ b/test/fixtures/cli/diff-tree.json @@ -1 +1 @@ -{"diffs":[{"diff":{"merge":{"term":"Statements","statements":[{"merge":{"term":"Method","methodAccessControl":"Public","methodBody":{"merge":{"children":[{"patch":{"insert":{"term":"Send","sourceRange":[13,16],"sendReceiver":null,"sendBlock":null,"sendArgs":[],"sourceSpan":{"start":[2,3],"end":[2,6]},"sendSelector":{"patch":{"insert":{"term":"Identifier","name":"baz","sourceRange":[13,16],"sourceSpan":{"start":[2,3],"end":[2,6]}}}}}}}],"before":{"sourceRange":[8,11],"sourceSpan":{"start":[2,1],"end":[2,4]}},"after":{"sourceRange":[13,16],"sourceSpan":{"start":[2,3],"end":[2,6]}}}},"methodContext":[],"methodName":{"patch":{"replace":[{"term":"Identifier","name":"foo","sourceRange":[4,7],"sourceSpan":{"start":[1,5],"end":[1,8]}},{"term":"Identifier","name":"bar","sourceRange":[4,7],"sourceSpan":{"start":[1,5],"end":[1,8]}}]}},"methodParameters":[{"patch":{"insert":{"term":"Identifier","name":"a","sourceRange":[8,9],"sourceSpan":{"start":[1,9],"end":[1,10]}}}}],"methodReceiver":{"merge":{"term":"Empty","before":{"sourceRange":[0,0],"sourceSpan":{"start":[1,1],"end":[1,1]}},"after":{"sourceRange":[0,0],"sourceSpan":{"start":[1,1],"end":[1,1]}}}},"before":{"sourceRange":[0,11],"sourceSpan":{"start":[1,1],"end":[2,4]}},"after":{"sourceRange":[0,20],"sourceSpan":{"start":[1,1],"end":[3,4]}}}}],"before":{"sourceRange":[0,12],"sourceSpan":{"start":[1,1],"end":[3,1]}},"after":{"sourceRange":[0,21],"sourceSpan":{"start":[1,1],"end":[4,1]}}}},"stat":{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb->test/fixtures/ruby/corpus/method-declaration.B.rb","replace":[{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb","language":"Ruby"},{"path":"test/fixtures/ruby/corpus/method-declaration.B.rb","language":"Ruby"}]}}]} +{"diffs":[{"diff":{"merge":{"term":"Statements","statements":[{"merge":{"term":"Method","methodAccessControl":"Public","methodBody":{"merge":{"children":[{"patch":{"insert":{"term":"Send","sourceRange":[13,16],"sendReceiver":null,"sendBlock":null,"sendArgs":[],"sourceSpan":{"start":[2,3],"end":[2,6]},"sendSelector":{"patch":{"insert":{"term":"Identifier","name":"baz","sourceRange":[13,16],"sourceSpan":{"start":[2,3],"end":[2,6]}}}}}}}],"before":{"sourceRange":[8,11],"sourceSpan":{"start":[2,1],"end":[2,4]}},"after":{"sourceRange":[13,16],"sourceSpan":{"start":[2,3],"end":[2,6]}}}},"methodContext":[],"methodName":{"patch":{"replace":[{"term":"Identifier","name":"foo","sourceRange":[4,7],"sourceSpan":{"start":[1,5],"end":[1,8]}},{"term":"Identifier","name":"bar","sourceRange":[4,7],"sourceSpan":{"start":[1,5],"end":[1,8]}}]}},"methodParameters":[{"patch":{"insert":{"term":"Identifier","name":"a","sourceRange":[8,9],"sourceSpan":{"start":[1,9],"end":[1,10]}}}}],"methodReceiver":{"merge":{"term":"Empty","before":{"sourceRange":[0,0],"sourceSpan":{"start":[1,1],"end":[1,1]}},"after":{"sourceRange":[0,0],"sourceSpan":{"start":[1,1],"end":[1,1]}}}},"before":{"sourceRange":[0,11],"sourceSpan":{"start":[1,1],"end":[2,4]}},"after":{"sourceRange":[0,20],"sourceSpan":{"start":[1,1],"end":[3,4]}}}}],"before":{"sourceRange":[0,12],"sourceSpan":{"start":[1,1],"end":[3,1]}},"after":{"sourceRange":[0,21],"sourceSpan":{"start":[1,1],"end":[4,1]}}}},"stat":{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb","replace":[{"path":"test/fixtures/ruby/corpus/method-declaration.A.rb","language":"Ruby"},{"path":"test/fixtures/ruby/corpus/method-declaration.B.rb","language":"Ruby"}]}}]} diff --git a/test/fixtures/cli/parse-tree.json b/test/fixtures/cli/parse-tree.json index 745c11a91..60ffc9554 100644 --- a/test/fixtures/cli/parse-tree.json +++ b/test/fixtures/cli/parse-tree.json @@ -1,62 +1 @@ -{ - "trees": [{ - "tree": { - "term": "Statements", - "statements": [{ - "term": "LowPrecedenceAnd", - "lhs": { - "term": "Send", - "sendArgs": [], - "sendBlock": null, - "sendReceiver": null, - "sendSelector": { - "term": "Identifier", - "name": "foo", - "sourceRange": [0, 3], - "sourceSpan": { - "start": [1, 1], - "end": [1, 4] - } - }, - "sourceRange": [0, 3], - "sourceSpan": { - "start": [1, 1], - "end": [1, 4] - } - }, - "rhs": { - "term": "Send", - "sendArgs": [], - "sendBlock": null, - "sendReceiver": null, - "sendSelector": { - "term": "Identifier", - "name": "bar", - "sourceRange": [8, 11], - "sourceSpan": { - "start": [1, 9], - "end": [1, 12] - } - }, - "sourceRange": [8, 11], - "sourceSpan": { - "start": [1, 9], - "end": [1, 12] - } - }, - "sourceRange": [0, 11], - "sourceSpan": { - "start": [1, 1], - "end": [1, 12] - } - }], - "sourceRange": [0, 12], - "sourceSpan": { - "start": [1, 1], - "end": [2, 1] - } - }, - "path": "test/fixtures/ruby/corpus/and-or.A.rb", - "language": "Ruby" - }] -} \ No newline at end of file +{"trees":[{"tree":{"term":"Statements","statements":[{"term":"LowPrecedenceAnd","lhs":{"term":"Send","sendArgs":[],"sendBlock":null,"sendReceiver":null,"sendSelector":{"term":"Identifier","name":"foo","sourceRange":[0,3],"sourceSpan":{"start":[1,1],"end":[1,4]}},"sourceRange":[0,3],"sourceSpan":{"start":[1,1],"end":[1,4]}},"rhs":{"term":"Send","sendArgs":[],"sendBlock":null,"sendReceiver":null,"sendSelector":{"term":"Identifier","name":"bar","sourceRange":[8,11],"sourceSpan":{"start":[1,9],"end":[1,12]}},"sourceRange":[8,11],"sourceSpan":{"start":[1,9],"end":[1,12]}},"sourceRange":[0,11],"sourceSpan":{"start":[1,1],"end":[1,12]}}],"sourceRange":[0,12],"sourceSpan":{"start":[1,1],"end":[2,1]}},"path":"test/fixtures/ruby/corpus/and-or.A.rb","language":"Ruby"}]}