diff --git a/semantic-core/src/Data/Loc.hs b/semantic-core/src/Data/Loc.hs index 68df85d41..3710c77f9 100644 --- a/semantic-core/src/Data/Loc.hs +++ b/semantic-core/src/Data/Loc.hs @@ -26,7 +26,6 @@ data Loc = Loc } deriving (Eq, Ord, Show) - data Span = Span { spanStart :: {-# UNPACK #-} !Pos , spanEnd :: {-# UNPACK #-} !Pos diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index b4b8d4499..2f4ae815f 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -50,9 +50,22 @@ test-suite test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Test.hs + ghc-options: -threaded + + other-modules: ScopeDump + , Directive + build-depends: semantic-python == 0.0.0.0 + , aeson ^>= 1.4.4.0 + , aeson-pretty ^>= 0.8.7 + , bytestring ^>= 0.10.8.2 + , directory ^>= 1.3.3.0 + , exceptions ^>= 0.10.2 + , filepath ^>= 1.4.2.1 + , process ^>= 1.6.5 + , streaming-process ^>= 0.1 + , streaming-bytestring ^>= 0.1.6 , tasty ^>= 1.2.3 , tasty-hunit ^>= 0.10.0.2 - , directory ^>= 1.3.3.0 - , filepath ^>= 1.4.2.1 - , bytestring ^>= 0.10.8.2 + , trifecta >= 2 && <3 + , unordered-containers ^>= 0.2.10 diff --git a/semantic-python/test/Directive.hs b/semantic-python/test/Directive.hs new file mode 100644 index 000000000..f5e5787ae --- /dev/null +++ b/semantic-python/test/Directive.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Directive ( Directive (..) + , parseDirective + , toProcess + ) where + +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as ByteString +import Data.Coerce +import System.Process +import qualified Text.Trifecta as Trifecta + +newtype Directive = JQ ByteString + +instance Show Directive where + show = ByteString.unpack . coerce + +directive :: Trifecta.Parser Directive +directive = do + Trifecta.string "# CHECK-JQ: " + JQ <$> Trifecta.restOfLine + +parseDirective :: ByteString -> Either String Directive +parseDirective = Trifecta.foldResult (Left . show) Right + . Trifecta.parseByteString (directive <* Trifecta.eof) mempty + +toProcess :: Directive -> CreateProcess +toProcess (JQ d) = proc "jq" ["-e", ByteString.unpack d] diff --git a/semantic-python/test/ScopeDump.hs b/semantic-python/test/ScopeDump.hs new file mode 100644 index 000000000..d45c10b4c --- /dev/null +++ b/semantic-python/test/ScopeDump.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards, TypeOperators #-} + +module ScopeDump ( ScopeDump (..), runScopeDump ) where + +import qualified Analysis.Eval as Eval +import Control.Effect +import Control.Effect.Fail +import Control.Effect.Reader +import qualified Data.Aeson as Aeson +import Data.Core +import Data.Function +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.Loc +import Data.Name +import Data.Term + +data ScopeDump + = DumpRecord (HashMap Name ScopeDump) + | Nil + deriving (Eq, Show) + +instance Semigroup ScopeDump where + DumpRecord lhs <> DumpRecord rhs = DumpRecord (HashMap.unionWith (<>) lhs rhs) + Nil <> rhs = rhs + lhs <> Nil = lhs + +instance Aeson.ToJSON ScopeDump where + toJSON (DumpRecord hs) = Aeson.Object (fmap Aeson.toJSON hs) + toJSON Nil = Aeson.Null + +scopeDump :: Applicative m => Eval.Analysis term () ScopeDump m +scopeDump = Eval.Analysis {..} where + alloc _name = pure () + bind _name _addr within = within + lookupEnv _name = pure (Just ()) + deref _addr = pure (Just Nil) + assign _addr _value = pure () + abstract _thing _name _term = pure Nil + apply _thing _fn _arg = pure Nil + unit = pure Nil + bool _b = pure Nil + asBool _val = pure True + string _s = pure Nil + asString _val = pure "" + record = pure . DumpRecord . HashMap.fromList + _addr ... _name = pure (Just ()) + +unhelpful :: Loc +unhelpful = Loc "" emptySpan + +runScopeDump :: Term (Ann :+: Core) Name -> Either String ScopeDump +runScopeDump + = run + . runFail + . runReader unhelpful + . fix (Eval.eval scopeDump) diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs index 25ec50211..3535988dd 100644 --- a/semantic-python/test/Test.hs +++ b/semantic-python/test/Test.hs @@ -1,14 +1,23 @@ -{-# LANGUAGE FlexibleInstances, TypeApplications #-} +{-# OPTIONS_GHC -Werror #-} +{-# LANGUAGE FlexibleInstances, TypeApplications, RecordWildCards, FlexibleContexts, TypeOperators, OverloadedStrings #-} module Main (main) where +import Prelude hiding (fail) import Control.Effect -import Control.Monad +import Control.Effect.Fresh +import Control.Effect.Fail +import Control.Effect.Reader +import Data.Function +import Control.Monad hiding (fail) import Control.Monad.Fail import Control.Monad.IO.Class -import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Char8 as ByteString +import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy import Data.Core +import Data.File import Data.Foldable +import Data.Loc import Data.List (sort, isInfixOf) import Data.Name import Data.Term @@ -19,20 +28,56 @@ import System.FilePath import qualified TreeSitter.Python as TSP import qualified TreeSitter.Python.AST as TSP import qualified TreeSitter.Unmarshal as TS +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Encode.Pretty as Aeson +import qualified Analysis.Eval as Eval +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import qualified Streaming.Process +import qualified Data.ByteString.Streaming.Char8 as ByteStream +import System.Exit +import Control.Monad.Catch +import Data.Core.Pretty +import Data.Maybe import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as HUnit +import qualified Directive +import ScopeDump + instance MonadFail (Either String) where fail = Left assertTranslationSucceeds :: HasCallStack => FilePath -> HUnit.Assertion assertTranslationSucceeds fp = withFrozenCallStack $ do - let shouldFail = "fails" `isInfixOf` fp || "disabled" `isInfixOf` fp - parsed <- ByteString.readFile ("semantic-python/test/fixtures" fp) >>= TS.parseByteString TSP.tree_sitter_python - case fmap (Py.compile @TSP.Module @_ @(Term Core)) parsed of - Right (Left err) -> unless shouldFail (HUnit.assertFailure ("Compilation failed: " <> err)) - Left err -> HUnit.assertFailure ("Parsing failed: " <> err) - _ -> pure () + let skipThisTest = "fails" `isInfixOf` fp || "disabled" `isInfixOf` fp + unless skipThisTest $ do + fileContents <- ByteString.readFile ("semantic-python/test/fixtures" fp) + let first = ByteString.takeWhile (/= '\n') fileContents + directive <- case Directive.parseDirective first of + Right dir -> pure dir + Left err -> HUnit.assertFailure ("Directive parsing error: " <> err) + + + result <- TS.parseByteString TSP.tree_sitter_python fileContents + core <- case fmap (Py.compile @TSP.Module @_ @(Term Core)) result of + Right (Right item) -> pure item + Right (Left err) -> HUnit.assertFailure ("Compilation failed: " <> err) + Left err -> HUnit.assertFailure ("Parsing failed: " <> err) + + dump <- case runScopeDump _ of + Left e -> HUnit.assertFailure ("Couldn't run scope dumping mechanism; this shouldn't happen (" <> e <> ")") + Right d -> pure $ Aeson.encodePretty d + + let jqPipeline = Streaming.Process.streamInput (Directive.toProcess directive) (ByteStream.fromLazy dump) + errorMsg = "jq(1) returned non-zero exit code" + dirMsg = "jq expression: " <> show directive + jsonMsg = "JSON value: " <> ByteString.Lazy.unpack dump + treeMsg = "Core expr: " <> showCore core + + catch jqPipeline $ \err -> do + HUnit.assertFailure (lines [errorMsg, dirMsg, jsonMsg, treeMsg]) + milestoneFixtures :: Tasty.TestTree milestoneFixtures = HUnit.testCaseSteps "Bootstrapping" $ \step -> do @@ -49,4 +94,7 @@ tests = Tasty.testGroup "Fixtures" ] main :: IO () -main = Tasty.defaultMain tests +main = do + jq <- findExecutable "jq" + when (isNothing jq) (die "Error: jq(1) not found in $PATH.") + Tasty.defaultMain tests diff --git a/semantic-python/test/fixtures/1-01-empty-module.py b/semantic-python/test/fixtures/1-01-empty-module.py index 8c5964340..4d5837619 100644 --- a/semantic-python/test/fixtures/1-01-empty-module.py +++ b/semantic-python/test/fixtures/1-01-empty-module.py @@ -1 +1 @@ -# CHECK-TOPLEVEL: empty +# CHECK-JQ: . == {} diff --git a/semantic-python/test/fixtures/1-02-pass-statement.py b/semantic-python/test/fixtures/1-02-pass-statement.py index fe0829980..5bf60534e 100644 --- a/semantic-python/test/fixtures/1-02-pass-statement.py +++ b/semantic-python/test/fixtures/1-02-pass-statement.py @@ -1,2 +1,2 @@ +# CHECK: top is record pass -# CHECK-TOPLEVEL: empty