1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00

Correct the specs.

This commit is contained in:
Rob Rix 2018-05-28 08:54:33 -04:00
parent ea94863148
commit 2993c3588c
5 changed files with 25 additions and 20 deletions

View File

@ -37,14 +37,14 @@ spec = parallel $ do
it "subclasses" $ do
((res, _), _) <- evaluate "subclass.py"
res `shouldBe` Right [injValue (String "\"bar\"")]
res `shouldBe` Right [String "\"bar\""]
it "handles multiple inheritance left-to-right" $ do
((res, _), _) <- evaluate "multiple_inheritance.py"
res `shouldBe` Right [injValue (String "\"foo!\"")]
res `shouldBe` Right [String "\"foo!\""]
where
ns n = Just . Latest . Last . Just . injValue . Namespace n
ns n = Just . Latest . Last . Just . Namespace n
addr = Address . Precise
fixtures = "test/fixtures/python/analysis/"
evaluate entry = evalPythonProject (fixtures <> entry)

View File

@ -22,7 +22,7 @@ spec = parallel $ do
describe "Ruby" $ do
it "evaluates require_relative" $ do
((res, state), _) <- evaluate "main.rb"
res `shouldBe` Right [injValue (Value.Integer (Number.Integer 1))]
res `shouldBe` Right [Value.Integer (Number.Integer 1)]
Env.names (environment state) `shouldContain` ["foo"]
it "evaluates load" $ do
@ -36,47 +36,47 @@ spec = parallel $ do
it "evaluates subclass" $ do
((res, state), _) <- evaluate "subclass.rb"
res `shouldBe` Right [injValue (String "\"<bar>\"")]
res `shouldBe` Right [String "\"<bar>\""]
Env.names (environment state) `shouldContain` [ "Bar", "Foo" ]
(derefQName (heap state) ("Bar" :| []) (environment state) >>= deNamespace) `shouldBe` Just ("Bar", ["baz", "foo", "inspect"])
it "evaluates modules" $ do
((res, state), _) <- evaluate "modules.rb"
res `shouldBe` Right [injValue (String "\"<hello>\"")]
res `shouldBe` Right [String "\"<hello>\""]
Env.names (environment state) `shouldContain` [ "Bar" ]
it "handles break correctly" $ do
((res, _), _) <- evaluate "break.rb"
res `shouldBe` Right [injValue (Value.Integer (Number.Integer 3))]
res `shouldBe` Right [Value.Integer (Number.Integer 3)]
it "handles break correctly" $ do
((res, _), _) <- evaluate "next.rb"
res `shouldBe` Right [injValue (Value.Integer (Number.Integer 8))]
res `shouldBe` Right [Value.Integer (Number.Integer 8)]
it "calls functions with arguments" $ do
((res, _), _) <- evaluate "call.rb"
res `shouldBe` Right [injValue (Value.Integer (Number.Integer 579))]
res `shouldBe` Right [Value.Integer (Number.Integer 579)]
it "evaluates early return statements" $ do
((res, _), _) <- evaluate "early-return.rb"
res `shouldBe` Right [injValue (Value.Integer (Number.Integer 123))]
res `shouldBe` Right [Value.Integer (Number.Integer 123)]
it "has prelude" $ do
((res, _), _) <- evaluate "preluded.rb"
res `shouldBe` Right [injValue (String "\"<foo>\"")]
res `shouldBe` Right [String "\"<foo>\""]
it "evaluates __LINE__" $ do
((res, _), _) <- evaluate "line.rb"
res `shouldBe` Right [injValue (Value.Integer (Number.Integer 4))]
res `shouldBe` Right [Value.Integer (Number.Integer 4)]
it "resolves builtins used in the prelude" $ do
((res, _), traces) <- evaluate "puts.rb"
res `shouldBe` Right [injValue Unit]
res `shouldBe` Right [Unit]
traces `shouldContain` [ "\"hello\"" ]
where
ns n = Just . Latest . Last . Just . injValue . Namespace n
ns n = Just . Latest . Last . Just . Namespace n
addr = Address . Precise
fixtures = "test/fixtures/ruby/analysis/"
evaluate entry = evalRubyProject (fixtures <> entry)

View File

@ -36,7 +36,7 @@ spec = parallel $ do
it "evaluates early return statements" $ do
((res, _), _) <- evaluate "early-return.ts"
res `shouldBe` Right [injValue (Value.Float (Number.Decimal 123.0))]
res `shouldBe` Right [Value.Float (Number.Decimal 123.0)]
where
fixtures = "test/fixtures/typescript/analysis/"

View File

@ -20,13 +20,13 @@ spec :: Spec
spec = parallel $ do
it "constructs integers" $ do
(expected, _) <- evaluate (integer 123)
expected `shouldBe` Right (injValue (Value.Integer (Number.Integer 123)))
expected `shouldBe` Right (Value.Integer (Number.Integer 123))
it "calls functions" $ do
(expected, _) <- evaluate $ do
identity <- closure [name "x"] lowerBound (variable (name "x"))
call identity [integer 123]
expected `shouldBe` Right (injValue (Value.Integer (Number.Integer 123)))
expected `shouldBe` Right (Value.Integer (Number.Integer 123))
evaluate
= runM

View File

@ -24,7 +24,7 @@ import Data.Abstract.FreeVariables as X
import Data.Abstract.Heap as X
import Data.Abstract.ModuleTable as X hiding (lookup)
import Data.Abstract.Name as X
import Data.Abstract.Value (Namespace(..), Value, ValueError, injValue, prjValue, runValueError)
import Data.Abstract.Value (Value(..), ValueError, runValueError)
import Data.Bifunctor (first)
import Data.Blob as X
import Data.ByteString.Builder (toLazyByteString)
@ -92,13 +92,18 @@ testEvaluating
. runTermEvaluator @_ @Precise
deNamespace :: Value Precise -> Maybe (Name, [Name])
deNamespace = fmap (namespaceName &&& Env.names . namespaceScope) . prjValue @(Namespace Precise)
deNamespace (Namespace name scope) = Just (name, Env.names scope)
deNamespace _ = Nothing
namespaceScope :: Value Precise -> Maybe (Environment Precise)
namespaceScope (Namespace _ scope) = Just scope
namespaceScope _ = Nothing
derefQName :: Heap Precise (Cell Precise) (Value Precise) -> NonEmpty Name -> Environment Precise -> Maybe (Value Precise)
derefQName heap = go
where go (n1 :| ns) env = Env.lookup n1 env >>= flip heapLookup heap >>= getLast . unLatest >>= case ns of
[] -> Just
(n2 : ns) -> fmap namespaceScope . prjValue @(Namespace Precise) >=> go (n2 :| ns)
(n2 : ns) -> namespaceScope >=> go (n2 :| ns)
newtype Verbatim = Verbatim ByteString
deriving (Eq)