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 diff --git a/cabal.project b/cabal.project index 5772f08158..e7b8e8637e 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 7ba07963b4..2c7f67288f 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 @@ -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 @@ -381,13 +382,16 @@ 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-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 + , temporary ^>= 1.3 if flag(release) ghc-options: -dynamic @@ -398,9 +402,9 @@ test-suite parse-examples main-is: Examples.hs build-depends: semantic , Glob - , hspec >= 2.4.1 + , hspec , hspec-core - , hspec-expectations-pretty-diff + , hspec-expectations benchmark evaluation import: haskell, executable-flags @@ -409,7 +413,7 @@ benchmark evaluation main-is: Main.hs ghc-options: -static build-depends: base - , criterion + , criterion ^>= 1.5 , semantic source-repository head diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index a750f46bbb..42e0c7a875 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 de74db45c2..950c14d905 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 a87e9e8bfc..b9b10fbbfc 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -1,9 +1,8 @@ +{-# OPTIONS_GHC -O0 #-} 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 1efe60f8ab..69aed61ce1 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 75169a1d43..4a86bf9965 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/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 62735b0a9b..88b98a786d 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 ab65902fff..972266b341 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/Data/Term/Spec.hs b/test/Data/Term/Spec.hs index ec4cc3ddde..2c785547e8 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 04933af76b..738a4fcaa0 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/Graphing/Calls/Spec.hs b/test/Graphing/Calls/Spec.hs index d5aa71dca7..7f43422507 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 bc10362891..e9167630a7 100644 --- a/test/Integration/Spec.hs +++ b/test/Integration/Spec.hs @@ -1,36 +1,52 @@ +{-# LANGUAGE ImplicitParams, LambdaCase, NamedFieldPuns #-} 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 +import System.IO.Unsafe import SpecHelpers +import Test.Tasty +import Test.Tasty.Golden + 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) + localOption (mkTimeout 3000000) $ testGroup language $ fmap testForExample items +{-# NOINLINE testsForLanguage #-} 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} -> + 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 -- | have the form: -- | @@ -81,18 +97,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 diff --git a/test/Parsing/Spec.hs b/test/Parsing/Spec.hs index 591e1328ad..d0e6ebc5cf 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 a811b6a0dc..adadcd19be 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/Reprinting/Spec.hs b/test/Reprinting/Spec.hs index b138e6c4cf..bbbbc3576f 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 54a9bcb45b..c7796a2099 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 284f03523f..fef994ba52 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 6a9a9ea94c..623cecfa4d 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 cfc46ea721..923d3afce0 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -1,36 +1,48 @@ 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 (File, Blob, BlobPair) -import Semantic.CLI -import Semantic.IO +import Semantic.Api hiding (Blob, BlobPair, File) import Semantic.Task import Serializing.Format +import System.Directory +import System.IO.Unsafe 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 + ] + +-- 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") + pure $ if useJD + then ["jd", "-set", ref, new] + else ["git", "diff", ref, new] +{-# NOINLINE renderDiff #-} + +testForDiffFixture (diffRenderer, runDiff, files, expected) = + goldenVsStringDiff + ("diff fixture renders to " <> diffRenderer <> " " <> show files) + renderDiff + expected + (fmap toLazyByteString . runTaskOrDie $ readBlobPairs (Right files) >>= runDiff) -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 - - 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 +testForParseFixture (format, runParse, files, expected) = + goldenVsStringDiff + ("diff fixture renders to " <> format <> " " <> show files) + renderDiff + expected + (fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse) parseFixtures :: [(String, [Blob] -> TaskEff Builder, [File], FilePath)] parseFixtures = diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs index baef0f3a8b..c57b30e5e4 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/Semantic/Spec.hs b/test/Semantic/Spec.hs index 76b53738ab..ba06a3dbd4 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/Spec.hs b/test/Spec.hs index 3497d6bd0b..5220b29f9d 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 + +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 +-- 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, 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 + 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.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 992f3524ed..b9f9a58012 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -10,8 +10,6 @@ module SpecHelpers , runTaskOrDie , TaskSession(..) , testEvaluating -, verbatim -, Verbatim(..) , toList , Config , LogQueue @@ -25,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) @@ -36,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) @@ -54,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 @@ -71,14 +65,10 @@ 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 -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) @@ -195,17 +185,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 diff --git a/test/fixtures/cli/diff-tree.json b/test/fixtures/cli/diff-tree.json index 42e9aa6427..d8c9bcfafb 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 d235422390..f0e0a42e42 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 ec8e3347d6..9cb7d5b7c5 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.json b/test/fixtures/cli/parse-tree.json index 745c11a91b..60ffc95547 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"}]} diff --git a/test/fixtures/cli/parse-tree.symbols.json b/test/fixtures/cli/parse-tree.symbols.json index eb92820091..d605418e75 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 3f91bf823c..5fad80b6d1 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"}]} diff --git a/test/fixtures/json/corpus/hash.diffA-B.txt b/test/fixtures/json/corpus/hash.diffA-B.txt index f9fa320ed2..3c0b1eaabd 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 952d54b0d2..4b8b4d151d 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)-})-})