mirror of
https://github.com/github/semantic.git
synced 2024-12-19 12:51:52 +03:00
Merge pull request #1670 from github/query-final-helpers
Some helpers to query Final
This commit is contained in:
commit
963bdf0699
@ -3,6 +3,9 @@ module Analysis.Abstract.Evaluating
|
||||
( type Evaluating
|
||||
, evaluate
|
||||
, evaluates
|
||||
, findValue
|
||||
, findEnv
|
||||
, findHeap
|
||||
, require
|
||||
, load
|
||||
) where
|
||||
@ -13,6 +16,7 @@ import Control.Monad.Effect.Resumable
|
||||
import Data.Abstract.Configuration
|
||||
import qualified Data.Abstract.Environment as Env
|
||||
import Data.Abstract.Environment (Environment)
|
||||
import Data.Abstract.Heap (Heap(..))
|
||||
import qualified Data.Abstract.Exports as Export
|
||||
import Data.Abstract.Exports (Exports)
|
||||
import Data.Abstract.Evaluatable
|
||||
@ -26,6 +30,7 @@ import Prelude hiding (fail)
|
||||
import Prologue hiding (throwError)
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Map.Monoidal as Monoidal
|
||||
import System.FilePath.Posix
|
||||
|
||||
-- | Evaluate a term to a value.
|
||||
@ -131,6 +136,21 @@ type EvaluatingEffects term value
|
||||
, State (IntMap.IntMap term) -- For jumps
|
||||
]
|
||||
|
||||
-- | Find the value in the 'Final' result of running.
|
||||
findValue :: forall value term effects . (effects ~ RequiredEffects term value (Evaluating term value effects))
|
||||
=> Final effects value -> Either Prelude.String (Either Prelude.String value)
|
||||
findValue (((((v, _), _), _), _), _) = v
|
||||
|
||||
-- | Find the 'Environment' in the 'Final' result of running.
|
||||
findEnv :: forall value term effects . (effects ~ RequiredEffects term value (Evaluating term value effects))
|
||||
=> Final effects value -> EnvironmentFor value
|
||||
findEnv (((((_, env), _), _), _), _) = env
|
||||
|
||||
-- | Find the 'Heap' in the 'Final' result of running.
|
||||
findHeap :: forall value term effects . (effects ~ RequiredEffects term value (Evaluating term value effects))
|
||||
=> Final effects value -> Monoidal.Map (LocationFor value) (CellFor value)
|
||||
findHeap (((((_, _), Heap heap), _), _), _) = heap
|
||||
|
||||
|
||||
instance Members '[Resumable Prelude.String value] effects => MonadThrow Prelude.String value (Evaluating term value effects) where
|
||||
throwException = raise . throwError
|
||||
|
@ -5,7 +5,7 @@ module Semantic.Util where
|
||||
|
||||
import Analysis.Abstract.Caching
|
||||
import Analysis.Abstract.Dead
|
||||
import Analysis.Abstract.Evaluating
|
||||
import Analysis.Abstract.Evaluating as X
|
||||
import Analysis.Abstract.Tracing
|
||||
import Analysis.Declaration
|
||||
import Control.Abstract.Analysis
|
||||
|
@ -12,30 +12,25 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "evalutes Go" $ do
|
||||
it "imports and wildcard imports" $ do
|
||||
env <- evaluate "main.go"
|
||||
let expectedEnv =
|
||||
[ (qualifiedName ["foo", "New"], addr 0)
|
||||
env <- findEnv <$> evaluate "main.go"
|
||||
env `shouldBe` [ (qualifiedName ["foo", "New"], addr 0)
|
||||
, (qualifiedName ["Rab"], addr 1)
|
||||
, (qualifiedName ["Bar"], addr 2)
|
||||
, (qualifiedName ["main"], addr 3)
|
||||
]
|
||||
env `shouldBe` expectedEnv
|
||||
|
||||
it "imports with aliases (and side effects only)" $ do
|
||||
env <- evaluate "main1.go"
|
||||
let expectedEnv =
|
||||
[ (qualifiedName ["f", "New"], addr 0)
|
||||
env <- findEnv <$> evaluate "main1.go"
|
||||
env `shouldBe` [ (qualifiedName ["f", "New"], addr 0)
|
||||
, (qualifiedName ["main"], addr 3) -- addr 3 is due to side effects of
|
||||
-- eval'ing `import _ "./bar"` which
|
||||
-- used addr 1 & 2.
|
||||
]
|
||||
env `shouldBe` expectedEnv
|
||||
|
||||
where
|
||||
addr = Address . Precise
|
||||
fixtures = "test/fixtures/go/analysis/"
|
||||
evaluate entry = snd . fst . fst . fst . fst <$>
|
||||
evaluateFiles goParser
|
||||
evaluate entry = evaluateFiles goParser
|
||||
[ fixtures <> entry
|
||||
, fixtures <> "foo/foo.go"
|
||||
, fixtures <> "bar/bar.go"
|
||||
|
@ -12,19 +12,21 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "PHP" $ do
|
||||
it "evaluates include and require" $ do
|
||||
env <- evaluate "main.php"
|
||||
env <- findEnv <$> evaluate "main.php"
|
||||
env `shouldBe` [ (name "foo", addr 0)
|
||||
, (name "bar", addr 1) ]
|
||||
|
||||
it "evaluates include_once and require_once" $ do
|
||||
env <- evaluate "main_once.php"
|
||||
env <- findEnv <$> evaluate "main_once.php"
|
||||
env `shouldBe` [ (name "foo", addr 0)
|
||||
, (name "bar", addr 1) ]
|
||||
|
||||
it "evaluates namespaces" $ do
|
||||
((_, env), Heap heap) <- evaluate' "namespaces.php"
|
||||
env `shouldBe` [ (name "NS1", addr 0)
|
||||
res <- evaluate "namespaces.php"
|
||||
findEnv res `shouldBe` [ (name "NS1", addr 0)
|
||||
, (name "Foo", addr 6) ]
|
||||
|
||||
let heap = findHeap res
|
||||
Map.lookup (Precise 0) heap `shouldBe` ns "NS1" [ (name "Sub1", addr 1)
|
||||
, (name "b", addr 4)
|
||||
, (name "c", addr 5)
|
||||
@ -36,9 +38,7 @@ spec = parallel $ do
|
||||
ns n = Just . Latest . Just . injValue . Namespace (name n)
|
||||
addr = Address . Precise
|
||||
fixtures = "test/fixtures/php/analysis/"
|
||||
evaluate entry = snd . fst <$> evaluate' entry
|
||||
evaluate' entry = fst . fst . fst <$>
|
||||
evaluateFiles phpParser
|
||||
evaluate entry = evaluateFiles phpParser
|
||||
[ fixtures <> entry
|
||||
, fixtures <> "foo.php"
|
||||
, fixtures <> "bar.php"
|
||||
|
@ -11,43 +11,35 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "evalutes Python" $ do
|
||||
it "imports" $ do
|
||||
env <- evaluate "main.py"
|
||||
let expectedEnv =
|
||||
[ (qualifiedName ["a", "foo"], addr 0)
|
||||
env <- findEnv <$> evaluate "main.py"
|
||||
env `shouldBe` [ (qualifiedName ["a", "foo"], addr 0)
|
||||
, (qualifiedName ["b", "c", "baz"], addr 1)
|
||||
]
|
||||
env `shouldBe` expectedEnv
|
||||
|
||||
it "imports with aliases" $ do
|
||||
env <- evaluate "main1.py"
|
||||
let expectedEnv =
|
||||
[ (qualifiedName ["b", "foo"], addr 0)
|
||||
env <- findEnv <$> evaluate "main1.py"
|
||||
env `shouldBe` [ (qualifiedName ["b", "foo"], addr 0)
|
||||
, (qualifiedName ["e", "baz"], addr 1)
|
||||
]
|
||||
env `shouldBe` expectedEnv
|
||||
|
||||
it "imports using 'from' syntax" $ do
|
||||
env <- evaluate "main2.py"
|
||||
let expectedEnv =
|
||||
[ (qualifiedName ["foo"], addr 0)
|
||||
env <- findEnv <$> evaluate "main2.py"
|
||||
env `shouldBe` [ (qualifiedName ["foo"], addr 0)
|
||||
, (qualifiedName ["bar"], addr 1)
|
||||
]
|
||||
env `shouldBe` expectedEnv
|
||||
|
||||
it "subclasses" $ do
|
||||
res <- evaluate' "subclass.py"
|
||||
join (fst res) `shouldBe` Right (injValue (String "\"bar\""))
|
||||
v <- findValue <$> evaluate "subclass.py"
|
||||
v `shouldBe` Right (Right (injValue (String "\"bar\"")))
|
||||
|
||||
it "handles multiple inheritance left-to-right" $ do
|
||||
res <- evaluate' "multiple_inheritance.py"
|
||||
join (fst res) `shouldBe` Right (injValue (String "\"foo!\""))
|
||||
v <- findValue <$> evaluate "multiple_inheritance.py"
|
||||
v `shouldBe` Right (Right (injValue (String "\"foo!\"")))
|
||||
|
||||
where
|
||||
addr = Address . Precise
|
||||
fixtures = "test/fixtures/python/analysis/"
|
||||
evaluate entry = snd <$> evaluate' entry
|
||||
evaluate' entry = fst . fst . fst . fst <$>
|
||||
evaluateFiles pythonParser
|
||||
evaluate entry = evaluateFiles pythonParser
|
||||
[ fixtures <> entry
|
||||
, fixtures <> "a.py"
|
||||
, fixtures <> "b/c.py"
|
||||
|
@ -12,30 +12,26 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "evalutes Ruby" $ do
|
||||
it "require_relative" $ do
|
||||
env <- evaluate "main.rb"
|
||||
let expectedEnv = [ (qualifiedName ["foo"], addr 0) ]
|
||||
env `shouldBe` expectedEnv
|
||||
env <- findEnv <$> evaluate "main.rb"
|
||||
env `shouldBe` [ (qualifiedName ["foo"], addr 0) ]
|
||||
|
||||
it "load" $ do
|
||||
env <- evaluate "load.rb"
|
||||
let expectedEnv = [ (qualifiedName ["foo"], addr 0) ]
|
||||
env `shouldBe` expectedEnv
|
||||
env <- findEnv <$> evaluate "load.rb"
|
||||
env `shouldBe` [ (qualifiedName ["foo"], addr 0) ]
|
||||
|
||||
it "load wrap" $ do
|
||||
res <- evaluate' "load-wrap.rb"
|
||||
fst res `shouldBe` Left "free variable: \"foo\""
|
||||
snd res `shouldBe` []
|
||||
res <- evaluate "load-wrap.rb"
|
||||
findValue res `shouldBe` Left "free variable: \"foo\""
|
||||
findEnv res `shouldBe` []
|
||||
|
||||
it "subclass" $ do
|
||||
res <- evaluate' "subclass.rb"
|
||||
join (fst res) `shouldBe` Right (injValue (String "\"<bar>\""))
|
||||
v <- findValue <$> evaluate "subclass.rb"
|
||||
v `shouldBe` Right (Right (injValue (String "\"<bar>\"")))
|
||||
|
||||
where
|
||||
addr = Address . Precise
|
||||
fixtures = "test/fixtures/ruby/analysis/"
|
||||
evaluate entry = snd <$> evaluate' entry
|
||||
evaluate' entry = fst . fst . fst . fst <$>
|
||||
evaluateFiles rubyParser
|
||||
evaluate entry = evaluateFiles rubyParser
|
||||
[ fixtures <> entry
|
||||
, fixtures <> "foo.rb"
|
||||
]
|
||||
|
@ -11,36 +11,29 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "evalutes TypeScript" $ do
|
||||
it "imports with aliased symbols" $ do
|
||||
env <- evaluate "main.ts"
|
||||
let expectedEnv =
|
||||
[ (qualifiedName ["bar"], addr 0)
|
||||
]
|
||||
env `shouldBe` expectedEnv
|
||||
env <- findEnv <$> evaluate "main.ts"
|
||||
env `shouldBe` [ (qualifiedName ["bar"], addr 0) ]
|
||||
|
||||
it "imports with qualified names" $ do
|
||||
env <- evaluate "main1.ts"
|
||||
let expectedEnv =
|
||||
[ (qualifiedName ["b", "baz"], addr 0)
|
||||
env <- findEnv <$> evaluate "main1.ts"
|
||||
env `shouldBe` [ (qualifiedName ["b", "baz"], addr 0)
|
||||
, (qualifiedName ["b", "foo"], addr 2)
|
||||
, (qualifiedName ["z", "baz"], addr 0)
|
||||
, (qualifiedName ["z", "foo"], addr 2)
|
||||
]
|
||||
env `shouldBe` expectedEnv
|
||||
|
||||
it "side effect only imports" $ do
|
||||
env <- evaluate "main2.ts"
|
||||
env <- findEnv <$> evaluate "main2.ts"
|
||||
env `shouldBe` mempty
|
||||
|
||||
it "fails exporting symbols not defined in the module" $ do
|
||||
env <- fst <$> evaluate' "bad-export.ts"
|
||||
env `shouldBe` Left "module \"foo\" does not export \"pip\""
|
||||
v <- findValue <$> evaluate "bad-export.ts"
|
||||
v `shouldBe` Left "module \"foo\" does not export \"pip\""
|
||||
|
||||
where
|
||||
addr = Address . Precise
|
||||
fixtures = "test/fixtures/typescript/analysis/"
|
||||
evaluate entry = snd <$> evaluate' entry
|
||||
evaluate' entry = fst . fst . fst . fst <$>
|
||||
evaluateFiles typescriptParser
|
||||
evaluate entry = evaluateFiles typescriptParser
|
||||
[ fixtures <> entry
|
||||
, fixtures <> "a.ts"
|
||||
, fixtures <> "foo.ts"
|
||||
|
@ -9,6 +9,7 @@ module SpecHelpers (
|
||||
, Verbatim(..)
|
||||
, ) where
|
||||
|
||||
import Analysis.Abstract.Evaluating as X (findValue, findEnv, findHeap)
|
||||
import Data.Abstract.Address as X
|
||||
import Data.Abstract.FreeVariables as X hiding (dropExtension)
|
||||
import Data.Abstract.Heap as X
|
||||
@ -44,6 +45,7 @@ import Test.LeanCheck as X
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Semantic.IO as IO
|
||||
|
||||
|
||||
-- | Returns an s-expression formatted diff for the specified FilePath pair.
|
||||
diffFilePaths :: Both FilePath -> IO ByteString
|
||||
diffFilePaths paths = readFilePair paths >>= runTask . diffBlobPair SExpressionDiffRenderer
|
||||
|
Loading…
Reference in New Issue
Block a user