Fix the shape of scope and heap outputs in testEvaluating

Co-Authored-By: Rick Winfrey <rick.winfrey@gmail.com>
2024-11-28 01:47:01 +03:00 · 2018-11-28 18:47:10 -05:00 · 2018-11-28 18:47:10 -05:00 · 65a8949a06
commit 65a8949a06
parent 456efeca9d
7 changed files with 62 additions and 45 deletions
--- a/test/Analysis/Go/Spec.hs
+++ b/test/Analysis/Go/Spec.hs
@ -13,20 +13,20 @@ spec config = parallel $ do
    it "imports and wildcard imports" $ do
      (_, res) <- evaluate ["main.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"]
      case ModuleTable.lookup "main.go" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
-          () <$ SpecHelpers.lookupDeclaration "foo" heap scopeGraph `shouldBe` Just ()
-          (SpecHelpers.lookupDeclaration "foo" heap scopeGraph >>= objectMembers heap scopeGraph . head) `shouldBe` Just ["New"]
-          () <$ SpecHelpers.lookupDeclaration "main" heap scopeGraph `shouldBe` Just ()
-          () <$ SpecHelpers.lookupDeclaration "Bar" heap scopeGraph `shouldBe` Just ()
-          () <$ SpecHelpers.lookupDeclaration "Rab" heap scopeGraph `shouldBe` Just ()
+        Right (Just (Module _ (scopeGraph, (heap, (addresses, valueRef))) :| [])) -> do
+          () <$ SpecHelpers.lookupDeclaration "foo" addresses heap scopeGraph `shouldBe` Just ()
+          (SpecHelpers.lookupDeclaration "foo" addresses heap scopeGraph >>= objectMembers heap scopeGraph . head) `shouldBe` Just ["New"]
+          () <$ SpecHelpers.lookupDeclaration "main" addresses heap scopeGraph `shouldBe` Just ()
+          () <$ SpecHelpers.lookupDeclaration "Bar" addresses heap scopeGraph `shouldBe` Just ()
+          () <$ SpecHelpers.lookupDeclaration "Rab" addresses heap scopeGraph `shouldBe` Just ()
        other -> expectationFailure (show other)

    it "imports with aliases (and side effects only)" $ do
      (_, res) <- evaluate ["main1.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"]
      case ModuleTable.lookup "main1.go" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
-          const () <$> SpecHelpers.lookupDeclaration "f" heap scopeGraph `shouldBe` Just ()
-          const () <$> SpecHelpers.lookupDeclaration "main" heap scopeGraph `shouldBe` Just ()
+        Right (Just (Module _ (scopeGraph, (heap, (addresses, valueRef))) :| [])) -> do
+          const () <$> SpecHelpers.lookupDeclaration "f" addresses heap scopeGraph `shouldBe` Just ()
+          const () <$> SpecHelpers.lookupDeclaration "main" addresses heap scopeGraph `shouldBe` Just ()
          -- (lookupDeclaration "f" heap >>= deNamespace heap) `shouldBe` Just ("f",  ["New"])
        other -> expectationFailure (show other)

--- a/test/Analysis/PHP/Spec.hs
+++ b/test/Analysis/PHP/Spec.hs
@ -15,7 +15,7 @@ spec config = parallel $ do
    it "evaluates include and require" $ do
      (_, res) <- evaluate ["main.php", "foo.php", "bar.php"]
      case ModuleTable.lookup "main.php" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), valueRef))) :| [])) -> do
          valueRef `shouldBe` Rval unit
          const () <$> SpecHelpers.lookupDeclaration "bar" heap scopeGraph `shouldBe` Just ()
          const () <$> SpecHelpers.lookupDeclaration "foo" heap scopeGraph `shouldBe` Just ()
@ -24,7 +24,7 @@ spec config = parallel $ do
    it "evaluates include_once and require_once" $ do
      (_, res) <- evaluate ["main_once.php", "foo.php", "bar.php"]
      case ModuleTable.lookup "main_once.php" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), valueRef))) :| [])) -> do
          valueRef `shouldBe` Rval unit
          const () <$> SpecHelpers.lookupDeclaration "bar" heap scopeGraph `shouldBe` Just ()
          const () <$> SpecHelpers.lookupDeclaration "foo" heap scopeGraph `shouldBe` Just ()
@ -33,7 +33,7 @@ spec config = parallel $ do
    it "evaluates namespaces" $ do
      (_, res) <- evaluate ["namespaces.php"]
      case ModuleTable.lookup "namespaces.php" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), valueRef))) :| [])) -> do
          const () <$> SpecHelpers.lookupDeclaration "Foo" heap scopeGraph `shouldBe` Just ()
          const () <$> SpecHelpers.lookupDeclaration "NS1" heap scopeGraph `shouldBe` Just ()

--- a/test/Analysis/Python/Spec.hs
+++ b/test/Analysis/Python/Spec.hs
@ -15,7 +15,7 @@ spec config = parallel $ do
    it "imports" $ do
      (_, res) <- evaluate ["main.py", "a.py", "b/__init__.py", "b/c.py"]
      case ModuleTable.lookup "main.py" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, value)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), value))) :| [])) -> do
          const () <$> SpecHelpers.lookupDeclaration "a" heap scopeGraph `shouldBe` Just ()
          const () <$> SpecHelpers.lookupDeclaration "b" heap scopeGraph `shouldBe` Just ()

@ -27,7 +27,7 @@ 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 _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), valueRef))) :| [])) -> do
          const () <$> SpecHelpers.lookupDeclaration "b" heap scopeGraph `shouldBe` Just ()
          const () <$> SpecHelpers.lookupDeclaration "e" heap scopeGraph `shouldBe` Just ()
        other -> expectationFailure (show other)
@ -35,7 +35,7 @@ spec config = parallel $ do
    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 _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), valueRef))) :| [])) -> do
          () <$ SpecHelpers.lookupDeclaration "bar" heap scopeGraph `shouldBe` Just ()
          () <$ SpecHelpers.lookupDeclaration "foo" heap scopeGraph `shouldBe` Just ()

@ -46,7 +46,7 @@ spec config = parallel $ do
    it "imports with relative syntax" $ do
      (_, res) <- evaluate ["main3.py", "c/__init__.py", "c/utils.py"]
      case ModuleTable.lookup "main3.py" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), valueRef)) :| [])) -> do
          const () <$> SpecHelpers.lookupDeclaration "utils" heap scopeGraph `shouldBe` Just ()
          -- (lookupDeclaration "utils" heap >>= deNamespace heap) `shouldBe` Just ("utils", ["to_s"])
        other -> expectationFailure (show other)
@ -54,14 +54,14 @@ spec config = parallel $ do
    it "subclasses" $ do
      (_, res) <- evaluate ["subclass.py"]
      case ModuleTable.lookup "subclass.py" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), valueRef))) :| [])) -> do
          SpecHelpers.lookupDeclaration undefined heap scopeGraph `shouldBe` Just [String "\"bar\""]
        other -> expectationFailure (show other)

    it "handles multiple inheritance left-to-right" $ do
      (_, res) <- evaluate ["multiple_inheritance.py"]
      case ModuleTable.lookup "multiple_inheritance.py" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), valueRef))) :| [])) -> do
          SpecHelpers.lookupDeclaration undefined heap scopeGraph `shouldBe` Just [String "\"foo!\""]
        other -> expectationFailure (show other)

--- a/test/Analysis/Ruby/Spec.hs
+++ b/test/Analysis/Ruby/Spec.hs
@ -21,15 +21,15 @@ spec config = parallel $ do
    it "evaluates require_relative" $ do
      (_, res) <- evaluate ["main.rb", "foo.rb"]
      case ModuleTable.lookup "main.rb" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeAndFrame, valueRef) :| [])) -> do
          valueRef `shouldBe` Rval (Value.Integer (Number.Integer 1))
-          const () <$> lookupDeclaration "foo" heap scopeGraph `shouldBe` Just ()
+          const () <$> lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just ()
        other -> expectationFailure (show other)

    it "evaluates load" $ do
      (_, res) <- evaluate ["load.rb", "foo.rb"]
      case ModuleTable.lookup "load.rb" <$> res of
-        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
+        Right (Just (Module _ (scopeGraph, (heap, ((currentScope, currentFrame), valueRef))) :| [])) -> do
          valueRef `shouldBe` Rval (Value.Integer (Number.Integer 1))
          const () <$> SpecHelpers.lookupDeclaration "foo" heap scopeGraph `shouldBe` Just ()
        other -> expectationFailure (show other)
--- a/test/Analysis/TypeScript/Spec.hs
+++ b/test/Analysis/TypeScript/Spec.hs
@ -67,7 +67,7 @@ spec config = parallel $ do
        Right (Just (Module _ (scopeGraph, (heap, valueRef)) :| [])) -> do
          fmap (const ()) <$> ScopeGraph.lookupScopePath "baz" scopeGraph `shouldBe` Nothing
          valueRef `shouldBe` Rval Unit
-          const () <$> Heap.currentFrame heap `shouldBe` Just ()
+          () <$ Heap.currentFrame heap `shouldBe` Just ()
          Heap.heapSize heap `shouldBe` 1
        other -> expectationFailure (show other)

--- a/test/Control/Abstract/Evaluator/Spec.hs
+++ b/test/Control/Abstract/Evaluator/Spec.hs
@ -27,11 +27,11 @@ import System.IO.Unsafe (unsafePerformIO)
 spec :: Spec
 spec = parallel $ do
  it "constructs integers" $ do
-    (_, (_, expected)) <- evaluate (rvalBox (integer 123))
+    (_, (_, (_, expected))) <- evaluate (rvalBox (integer 123))
    expected `shouldBe` Right (Rval (Value.Integer (Number.Integer 123)))

  it "calls functions" $ do
-    (_, (_, expected)) <- evaluate $ do
+    (_, (_, (_, expected))) <- evaluate $ do
      withLexicalScopeAndFrame $ do
        declare (ScopeGraph.Declaration "identity") emptySpan Nothing
        valueRef <- function "identity" [ SpecHelpers.name "x", SpecHelpers.name "y" ]
@ -56,18 +56,27 @@ evaluate
  . evalState (lowerBound @Span)
  . runReader (lowerBound @Span)
  . runEvaluator
-  . fmap reassociate
-  . runScopeError
-  . runHeapError
-  . runValueError
-  . runAddressError
-  . runEvalError
-  . runDeref @Val
  . runAllocator
-  . runReturn
-  . runLoopControl
-  . runBoolean
-  . runFunction runSpecEff
+  . evalModule
+  where
+    evalModule action = do
+      scopeAddress <- newScope mempty
+      frameAddress <- newFrame scopeAddress mempty
+      val <- raiseHandler (runReader (scopeAddress, frameAddress))
+        . fmap reassociate
+        . runScopeError
+        . runHeapError
+        . runValueError
+        . runAddressError
+        . runEvalError
+        . runDeref @Val
+        . runAllocator
+        . runReturn
+        . runLoopControl
+        . runBoolean
+        . runFunction runSpecEff
+        $ action
+      pure ((scopeAddress, frameAddress), val)

 reassociate :: Either (SomeError exc1) (Either (SomeError exc2) (Either (SomeError exc3) (Either (SomeError exc4) (Either (SomeError exc5) result)))) -> Either (SomeError (Sum '[exc5, exc4, exc3, exc2, exc1])) result
 reassociate = mergeErrors . mergeErrors . mergeErrors . mergeErrors . mergeErrors . Right
@ -85,6 +94,8 @@ newtype SpecEff = SpecEff
                 (Eff (ResumableC (BaseError (ValueError SpecEff Precise))
                 (Eff (ResumableC (BaseError (HeapError Precise))
                 (Eff (ResumableC (BaseError (ScopeError Precise))
+                 (Eff (ReaderC (Precise, Precise)
+                 (Eff (AllocatorC Precise
                 (Eff (ReaderC Span
                 (Eff (StateC Span
                 (Eff (ReaderC ModuleInfo
@ -93,7 +104,7 @@ newtype SpecEff = SpecEff
                 (Eff (StateC (Heap Precise Precise Val)
                 (Eff (StateC (ScopeGraph Precise)
                 (Eff (TraceByIgnoringC
-                 (Eff (LiftC IO)))))))))))))))))))))))))))))))))))))))
+                 (Eff (LiftC IO)))))))))))))))))))))))))))))))))))))))))))
                 (ValueRef Precise Val)
  }

@ -104,5 +115,5 @@ instance FreeVariables SpecEff where freeVariables _ = lowerBound
 instance Declarations SpecEff where
  declaredName eff =
    case unsafePerformIO (evaluate $ runSpecEff eff) of
-      (_, (_, Right (Rval (Value.Symbol text)))) -> Just (SpecHelpers.name text)
+      (_, (_, (_, Right (Rval (Value.Symbol text))))) -> Just (SpecHelpers.name text)
      _ -> error "declaredName for SpecEff should return an RVal"
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@ -59,6 +59,7 @@ import Semantic.Diff as X
 import Semantic.Parse as X
 import Semantic.Task as X hiding (parsePackage)
 import Semantic.Util as X
+import Semantic.Graph (runHeap, runScopeGraph)
 import System.FilePath as X

 import Data.ByteString as X (ByteString)
@ -117,9 +118,12 @@ type TestEvaluatingC term
  ( ResumableC (BaseError (ScopeError Precise)) (Eff
  ( ResumableC (BaseError (UnspecializedError (Val term))) (Eff
  ( ResumableC (BaseError (LoadError Precise (Val term))) (Eff
+
+  (StateC (Heap Precise Precise (Val term)) (Eff
+  (StateC (ScopeGraph Precise) (Eff
  ( FreshC (Eff
  ( TraceByReturningC (Eff
-  ( LiftC IO))))))))))))))))))))
+  ( LiftC IO))))))))))))))))))))))))
 type TestEvaluatingErrors term
  = '[ BaseError (AddressError Precise (Val term))
     , BaseError (ValueError term Precise)
@ -132,14 +136,16 @@ type TestEvaluatingErrors term
     ]
 testEvaluating :: Evaluator term Precise (Val term) (TestEvaluatingC term) (Span, a)
               -> IO
-                 ( [String]
-                 , Either (SomeError (Data.Sum.Sum (TestEvaluatingErrors term))) a
-                 )
+                  (ScopeGraph Precise,
+                    (Heap Precise Precise (Value term Precise),
+                     Either (SomeError (Data.Sum.Sum (TestEvaluatingErrors term))) a))
 testEvaluating
  = runM
-  . runTraceByReturning
+  . runTraceByIgnoring
  . runFresh
  . runEvaluator
+  . runScopeGraph
+  . runHeap
  . fmap reassociate
  . runLoadError
  . runUnspecialized
@ -185,9 +191,9 @@ frameNames heap scopeGraph frame = do
 -- namespaceScope _ _ = Nothing

 lookupDeclaration :: Name -> (Precise, Precise) -> Heap Precise Precise (Value term Precise) -> ScopeGraph Precise -> Maybe [ Value term Precise ]
-lookupDeclaration name (currenScope, currentFrame) heap scopeGraph = do
-  path <- ScopeGraph.lookupScopePath name scopeGraph
-  frameAddress <- Heap.lookupFrameAddress path heap
+lookupDeclaration name (currentScope, currentFrame) heap scopeGraph = do
+  path <- ScopeGraph.lookupScopePath name currentScope scopeGraph
+  frameAddress <- Heap.lookupFrameAddress path currentFrame heap
  toList <$> Heap.getSlot (Address frameAddress (Heap.pathPosition path)) heap

 newtype Verbatim = Verbatim ByteString