github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 17:04:47 +03:00
Code Issues Projects Releases Wiki Activity

Fix test type errors

Browse Source
This commit is contained in:
joshvera 2018-09-14 18:04:08 -04:00
parent 41881f3057
commit eb71b512b3
7 changed files with 43 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Data/Abstract/Evaluatable.hs
View File

@ -129,7 +129,7 @@ evaluate :: ( AbstractValue address value valueEffects
-> [Module term]
-> TermEvaluator term address value effects (ModuleTable (NonEmpty (Module (ModuleResult address))))
evaluate lang analyzeModule analyzeTerm runAllocDeref runValue modules = do
(scopeGraph, (preludeBinds, _)) <- TermEvaluator . runInModule lowerBound moduleInfoFromCallStack . runValue $ do
(_, (preludeBinds, _)) <- TermEvaluator . runInModule lowerBound moduleInfoFromCallStack . runValue $ do
definePrelude lang
box unit
foldr (run preludeBinds) ask modules

4
test/Analysis/Go/Spec.hs
View File

@ -14,7 +14,7 @@ spec config = parallel $ do
it "imports and wildcard imports" $ do
(_, (heap, res)) <- evaluate ["main.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"]
case ModuleTable.lookup "main.go" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
Env.names env `shouldBe` [ "Bar", "Rab", "foo", "main" ]
(derefQName heap ("foo" :| []) env >>= deNamespace heap) `shouldBe` Just ("foo", ["New"])
other -> expectationFailure (show other)
@ -22,7 +22,7 @@ spec config = parallel $ do
it "imports with aliases (and side effects only)" $ do
(_, (heap, res)) <- evaluate ["main1.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"]
case ModuleTable.lookup "main1.go" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
Env.names env `shouldBe` [ "f", "main" ]
(derefQName heap ("f" :| []) env >>= deNamespace heap) `shouldBe` Just ("f", ["New"])
other -> expectationFailure (show other)

6
test/Analysis/PHP/Spec.hs
View File

@ -15,7 +15,7 @@ spec config = parallel $ do
it "evaluates include and require" $ do
(_, (heap, res)) <- evaluate ["main.php", "foo.php", "bar.php"]
case ModuleTable.lookup "main.php" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
heapLookupAll addr heap `shouldBe` Just [unit]
Env.names env `shouldBe` [ "bar", "foo" ]
other -> expectationFailure (show other)
@ -23,7 +23,7 @@ spec config = parallel $ do
it "evaluates include_once and require_once" $ do
(_, (heap, res)) <- evaluate ["main_once.php", "foo.php", "bar.php"]
case ModuleTable.lookup "main_once.php" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
heapLookupAll addr heap `shouldBe` Just [unit]
Env.names env `shouldBe` [ "bar", "foo" ]
other -> expectationFailure (show other)
@ -31,7 +31,7 @@ spec config = parallel $ do
it "evaluates namespaces" $ do
(_, (heap, res)) <- evaluate ["namespaces.php"]
case ModuleTable.lookup "namespaces.php" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
Env.names env `shouldBe` [ "Foo", "NS1" ]
(derefQName heap ("NS1" :| []) env >>= deNamespace heap) `shouldBe` Just ("NS1", ["Sub1", "b", "c"])

12
test/Analysis/Python/Spec.hs
View File

@ -16,7 +16,7 @@ spec config = parallel $ do
it "imports" $ do
(_, (heap, res)) <- evaluate ["main.py", "a.py", "b/__init__.py", "b/c.py"]
case ModuleTable.lookup "main.py" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
Env.names env `shouldContain` [ "a", "b" ]
(derefQName heap ("a" :| []) env >>= deNamespace heap) `shouldBe` Just ("a", ["foo"])
@ -27,19 +27,19 @@ spec config = parallel $ do
it "imports with aliases" $ do
(_, (_, res)) <- evaluate ["main1.py", "a.py", "b/__init__.py", "b/c.py"]
case ModuleTable.lookup "main1.py" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> Env.names env `shouldContain` [ "b", "e" ]
Right (Just (Module _ (_, (env, addr)) :| [])) -> Env.names env `shouldContain` [ "b", "e" ]
other -> expectationFailure (show other)
it "imports using 'from' syntax" $ do
(_, (_, res)) <- evaluate ["main2.py", "a.py", "b/__init__.py", "b/c.py"]
case ModuleTable.lookup "main2.py" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> Env.names env `shouldContain` [ "bar", "foo" ]
Right (Just (Module _ (_, (env, addr)) :| [])) -> Env.names env `shouldContain` [ "bar", "foo" ]
other -> expectationFailure (show other)
it "imports with relative syntax" $ do
(_, (heap, res)) <- evaluate ["main3.py", "c/__init__.py", "c/utils.py"]
case ModuleTable.lookup "main3.py" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
Env.names env `shouldContain` [ "utils" ]
(derefQName heap ("utils" :| []) env >>= deNamespace heap) `shouldBe` Just ("utils", ["to_s"])
other -> expectationFailure (show other)
@ -47,13 +47,13 @@ spec config = parallel $ do
it "subclasses" $ do
(_, (heap, res)) <- evaluate ["subclass.py"]
case ModuleTable.lookup "subclass.py" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"bar\""]
Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"bar\""]
other -> expectationFailure (show other)
it "handles multiple inheritance left-to-right" $ do
(_, (heap, res)) <- evaluate ["multiple_inheritance.py"]
case ModuleTable.lookup "multiple_inheritance.py" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"foo!\""]
Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"foo!\""]
other -> expectationFailure (show other)
where

22
test/Analysis/Ruby/Spec.hs
View File

@ -21,7 +21,7 @@ spec config = parallel $ do
it "evaluates require_relative" $ do
(_, (heap, res)) <- evaluate ["main.rb", "foo.rb"]
case ModuleTable.lookup "main.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 1)]
Env.names env `shouldContain` [ "foo" ]
other -> expectationFailure (show other)
@ -29,7 +29,7 @@ spec config = parallel $ do
it "evaluates load" $ do
(_, (heap, res)) <- evaluate ["load.rb", "foo.rb"]
case ModuleTable.lookup "load.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 1)]
Env.names env `shouldContain` [ "foo" ]
other -> expectationFailure (show other)
@ -41,7 +41,7 @@ spec config = parallel $ do
it "evaluates subclass" $ do
(_, (heap, res)) <- evaluate ["subclass.rb"]
case ModuleTable.lookup "subclass.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
heapLookupAll addr heap `shouldBe` Just [String "\"<bar>\""]
Env.names env `shouldContain` [ "Bar", "Foo" ]
@ -51,7 +51,7 @@ spec config = parallel $ do
it "evaluates modules" $ do
(_, (heap, res)) <- evaluate ["modules.rb"]
case ModuleTable.lookup "modules.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
heapLookupAll addr heap `shouldBe` Just [String "\"<hello>\""]
Env.names env `shouldContain` [ "Bar" ]
other -> expectationFailure (show other)
@ -59,43 +59,43 @@ spec config = parallel $ do
it "handles break correctly" $ do
(_, (heap, res)) <- evaluate ["break.rb"]
case ModuleTable.lookup "break.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
other -> expectationFailure (show other)
it "handles next correctly" $ do
(_, (heap, res)) <- evaluate ["next.rb"]
case ModuleTable.lookup "next.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 8)]
Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 8)]
other -> expectationFailure (show other)
it "calls functions with arguments" $ do
(_, (heap, res)) <- evaluate ["call.rb"]
case ModuleTable.lookup "call.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 579)]
Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 579)]
other -> expectationFailure (show other)
it "evaluates early return statements" $ do
(_, (heap, res)) <- evaluate ["early-return.rb"]
case ModuleTable.lookup "early-return.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 123)]
Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 123)]
other -> expectationFailure (show other)
it "has prelude" $ do
(_, (heap, res)) <- evaluate ["preluded.rb"]
case ModuleTable.lookup "preluded.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"<foo>\""]
Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"<foo>\""]
other -> expectationFailure (show other)
it "evaluates __LINE__" $ do
(_, (heap, res)) <- evaluate ["line.rb"]
case ModuleTable.lookup "line.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 4)]
Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 4)]
other -> expectationFailure (show other)
it "resolves builtins used in the prelude" $ do
(traces, (heap, res)) <- evaluate ["puts.rb"]
case ModuleTable.lookup "puts.rb" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
heapLookupAll addr heap `shouldBe` Just [Unit]
traces `shouldContain` [ "\"hello\"" ]
other -> expectationFailure (show other)

30
test/Analysis/TypeScript/Spec.hs
View File

@ -17,13 +17,13 @@ spec config = parallel $ do
it "imports with aliased symbols" $ do
(_, (_, res)) <- evaluate ["main.ts", "foo.ts", "a.ts", "foo/b.ts"]
case ModuleTable.lookup "main.ts" <$> res of
Right (Just (Module _ (env, _) :| [])) -> Env.names env `shouldBe` [ "bar", "quz" ]
Right (Just (Module _ (_, (env, _)) :| [])) -> Env.names env `shouldBe` [ "bar", "quz" ]
other -> expectationFailure (show other)
it "imports with qualified names" $ do
(_, (heap, res)) <- evaluate ["main1.ts", "foo.ts", "a.ts"]
case ModuleTable.lookup "main1.ts" <$> res of
Right (Just (Module _ (env, _) :| [])) -> do
Right (Just (Module _ (_, (env, _)) :| [])) -> do
Env.names env `shouldBe` [ "b", "z" ]
(derefQName heap ("b" :| []) env >>= deNamespace heap) `shouldBe` Just ("b", [ "baz", "foo" ])
@ -33,7 +33,7 @@ spec config = parallel $ do
it "side effect only imports" $ do
(_, (_, res)) <- evaluate ["main2.ts", "a.ts", "foo.ts"]
case ModuleTable.lookup "main2.ts" <$> res of
Right (Just (Module _ (env, _) :| [])) -> env `shouldBe` lowerBound
Right (Just (Module _ (_, (env, _)) :| [])) -> env `shouldBe` lowerBound
other -> expectationFailure (show other)
it "fails exporting symbols not defined in the module" $ do
@ -43,13 +43,13 @@ spec config = parallel $ do
it "evaluates early return statements" $ do
(_, (heap, res)) <- evaluate ["early-return.ts"]
case ModuleTable.lookup "early-return.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Float (Number.Decimal 123.0)]
Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Float (Number.Decimal 123.0)]
other -> expectationFailure (show other)
it "evaluates sequence expressions" $ do
(_, (heap, res)) <- evaluate ["sequence-expression.ts"]
case ModuleTable.lookup "sequence-expression.ts" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
Env.names env `shouldBe` [ "x" ]
(derefQName heap ("x" :| []) env) `shouldBe` Just (Value.Float (Number.Decimal 3.0))
other -> expectationFailure (show other)
@ -57,13 +57,13 @@ spec config = parallel $ do
it "evaluates void expressions" $ do
(_, (heap, res)) <- evaluate ["void.ts"]
case ModuleTable.lookup "void.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Null]
Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Null]
other -> expectationFailure (show other)
it "evaluates delete" $ do
(_, (heap, res)) <- evaluate ["delete.ts"]
case ModuleTable.lookup "delete.ts" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
heapLookupAll addr heap `shouldBe` Just [Unit]
(derefQName heap ("x" :| []) env) `shouldBe` Nothing
Env.names env `shouldBe` [ "x" ]
@ -72,7 +72,7 @@ spec config = parallel $ do
it "evaluates await" $ do
(_, (heap, res)) <- evaluate ["await.ts"]
case ModuleTable.lookup "await.ts" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Right (Just (Module _ (_, (env, addr)) :| [])) -> do
Env.names env `shouldBe` [ "f2" ]
(derefQName heap ("y" :| []) env) `shouldBe` Nothing
other -> expectationFailure (show other)
@ -80,41 +80,41 @@ spec config = parallel $ do
it "evaluates BOr statements" $ do
(_, (heap, res)) <- evaluate ["bor.ts"]
case ModuleTable.lookup "bor.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
other -> expectationFailure (show other)
it "evaluates BAnd statements" $ do
(_, (heap, res)) <- evaluate ["band.ts"]
case ModuleTable.lookup "band.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
other -> expectationFailure (show other)
it "evaluates BXOr statements" $ do
(_, (heap, res)) <- evaluate ["bxor.ts"]
case ModuleTable.lookup "bxor.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
other -> expectationFailure (show other)
it "evaluates LShift statements" $ do
(_, (heap, res)) <- evaluate ["lshift.ts"]
case ModuleTable.lookup "lshift.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 4)]
Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 4)]
other -> expectationFailure (show other)
it "evaluates RShift statements" $ do
(_, (heap, res)) <- evaluate ["rshift.ts"]
case ModuleTable.lookup "rshift.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
other -> expectationFailure (show other)
it "evaluates Complement statements" $ do
(_, (heap, res)) <- evaluate ["complement.ts"]
case ModuleTable.lookup "complement.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer (-2))]
Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer (-2))]
other -> expectationFailure (show other)
where
fixtures = "test/fixtures/typescript/analysis/"
evaluate = evalTypeScriptProject . map (fixtures <>)
evalTypeScriptProject = testEvaluating <=< evaluateProject' config (Proxy :: Proxy 'Language.TypeScript) typescriptParser
evalTypeScriptProject = testEvaluating <=< (evaluateProject' config (Proxy :: Proxy 'Language.TypeScript) typescriptParser)

8
test/SpecHelpers.hs
View File

@ -118,12 +118,12 @@ type TestEvaluatingErrors = '[ BaseError (ValueError Precise (ConcreteEff Precis
, BaseError (UnspecializedError Val)
, BaseError (LoadError Precise)
]
testEvaluating :: Evaluator Precise Val TestEvaluatingEffects (ModuleTable (NonEmpty (Module (ModuleResult Precise))))
testEvaluating :: Evaluator Precise Val TestEvaluatingEffects (Span, a)
-> IO
( [String]
, ( Heap Precise Val
, Either (SomeExc (Data.Sum.Sum TestEvaluatingErrors))
(ModuleTable (NonEmpty (Module (ModuleResult Precise))))
a
)
)
testEvaluating
@ -139,6 +139,7 @@ testEvaluating
. runResolutionError
. runAddressError
. runValueError @_ @Precise @(ConcreteEff Precise _)
. fmap snd
type Val = Value Precise (ConcreteEff Precise '[Trace, Lift IO])
@ -153,11 +154,12 @@ namespaceScope :: Heap Precise (Value Precise term)
-> Value Precise term
-> Maybe (Environment Precise)
namespaceScope heap ns@(Namespace _ _ _)
= either (const Nothing) snd
= either (const Nothing) (snd . snd)
. run
. runFresh 0
. runAddressError
. runState heap
. runState (lowerBound @Span)
. runReader (lowerBound @Span)
. runReader (ModuleInfo "SpecHelper.hs")
. runDeref