mirror of
https://github.com/github/semantic.git
synced 2024-12-25 07:55:12 +03:00
Merge branch 'master' into reprinting-pipeline-rename
This commit is contained in:
commit
ba18287311
@ -393,6 +393,27 @@ test-suite lint
|
||||
build-depends: base
|
||||
, hlint
|
||||
|
||||
test-suite parse-examples
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Examples.hs
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -j
|
||||
build-depends: base
|
||||
, bytestring
|
||||
, directory
|
||||
, effects
|
||||
, fastsum
|
||||
, filepath
|
||||
, Glob
|
||||
, hspec >= 2.4.1
|
||||
, hspec-core
|
||||
, hspec-expectations-pretty-diff
|
||||
, process
|
||||
, semantic
|
||||
default-extensions: RecordWildCards
|
||||
, FlexibleContexts
|
||||
|
||||
test-suite doctests
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
|
@ -535,7 +535,7 @@ varDeclaration :: Assignment Term
|
||||
varDeclaration = (symbol ConstDeclaration <|> symbol VarDeclaration) *> children expressions
|
||||
|
||||
variadicArgument :: Assignment Term
|
||||
variadicArgument = makeTerm <$> symbol VariadicArgument <*> children (Go.Syntax.Variadic [] <$> expression)
|
||||
variadicArgument = makeTerm <$> symbol VariadicArgument <*> children (Go.Syntax.Variadic [] <$> expressions)
|
||||
|
||||
variadicParameterDeclaration :: Assignment Term
|
||||
variadicParameterDeclaration = makeTerm <$> symbol VariadicParameterDeclaration <*> children (flip Go.Syntax.Variadic <$> (expression <|> emptyTerm) <* token AnonDotDotDot <*> many expression)
|
||||
|
@ -465,9 +465,13 @@ raiseStatement :: Assignment Term
|
||||
raiseStatement = makeTerm <$> symbol RaiseStatement <*> children (Statement.Throw <$> expressions)
|
||||
|
||||
ifStatement :: Assignment Term
|
||||
ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> term expression <*> term (makeTerm <$> location <*> manyTermsTill expression (void (symbol ElseClause) <|> void (symbol ElifClause) <|> eof)) <*> (flip (foldr makeElif) <$> many elifClause <*> (symbol ElseClause *> children expressions <|> emptyTerm)))
|
||||
where elifClause = (,) <$> symbol ElifClause <*> children (Statement.If <$> term expression <*> expressions)
|
||||
makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
|
||||
ifStatement = makeTerm <$> symbol IfStatement <*> children if'
|
||||
where
|
||||
if' = Statement.If <$> term expression <*> thenClause <*> (elseClause <|> emptyTerm)
|
||||
thenClause = makeTerm <$> location <*> manyTermsTill expression (void (symbol ElseClause) <|> void (symbol ElifClause) <|> eof)
|
||||
elseClause = makeTerm <$> location <*> many (comment <|> elif <|> else')
|
||||
elif = makeTerm <$> symbol ElifClause <*> children if'
|
||||
else' = symbol ElseClause *> children expressions
|
||||
|
||||
execStatement :: Assignment Term
|
||||
execStatement = makeTerm <$> symbol ExecStatement <*> children (Expression.Call [] <$> term (makeTerm <$> location <*> (Syntax.Identifier . name <$> source)) <*> manyTerm (string <|> expression) <*> emptyTerm)
|
||||
|
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE GADTs, RankNTypes #-}
|
||||
module Semantic.Parse ( runParse ) where
|
||||
module Semantic.Parse ( runParse, runParse' ) where
|
||||
|
||||
import Analysis.ConstructorName (ConstructorName)
|
||||
import Analysis.Declaration (HasDeclaration, declarationAlgebra)
|
||||
@ -32,6 +32,10 @@ runParse ShowTermRenderer = withParsedBlobs (\_ _ -> mempty) (const
|
||||
runParse (SymbolsTermRenderer fields) = withParsedBlobs (\_ _ -> mempty) (\ blob -> decorate (declarationAlgebra blob) >=> render (renderSymbolTerms . renderToSymbols fields blob)) >=> serialize JSON
|
||||
runParse DOTTermRenderer = withParsedBlobs (\_ _ -> mempty) (const (render renderTreeGraph)) >=> serialize (DOT (termStyle "terms"))
|
||||
|
||||
|
||||
runParse' :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs Builder
|
||||
runParse' blob = parseSomeBlob blob >>= withSomeTerm (serialize Show . quieterm)
|
||||
|
||||
withParsedBlobs ::
|
||||
( Member Distribute effs
|
||||
, Member (Exc SomeException) effs
|
||||
|
@ -41,13 +41,15 @@ module Semantic.Task
|
||||
, runTaskWithConfig
|
||||
, runTraceInTelemetry
|
||||
, runTaskF
|
||||
-- * Exceptions
|
||||
, ParserCancelled(..)
|
||||
-- * Re-exports
|
||||
, Distribute
|
||||
, Eff
|
||||
, Exc
|
||||
, Lift
|
||||
, throwError
|
||||
, SomeException
|
||||
, SomeException(..)
|
||||
, Telemetry
|
||||
) where
|
||||
|
||||
|
105
test/Examples.hs
Normal file
105
test/Examples.hs
Normal file
@ -0,0 +1,105 @@
|
||||
module Main (main) where
|
||||
|
||||
import Control.Exception (displayException)
|
||||
import Control.Monad
|
||||
import Control.Monad.Effect
|
||||
import Control.Monad.Effect.Exception
|
||||
import qualified Data.ByteString as B
|
||||
import Data.ByteString.Builder
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.Either
|
||||
import Data.Foldable
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Project (file)
|
||||
import Data.Quieterm
|
||||
import Data.Typeable (cast)
|
||||
import Data.Void
|
||||
import Parsing.Parser
|
||||
import Rendering.Renderer
|
||||
import Semantic.Config (Config (..), Options (..), defaultOptions)
|
||||
import qualified Semantic.IO as IO
|
||||
import Semantic.Parse
|
||||
import Semantic.Task
|
||||
import Semantic.Util (TaskConfig (..))
|
||||
import System.Directory
|
||||
import System.Exit (die)
|
||||
import System.FilePath.Glob
|
||||
import System.FilePath.Posix
|
||||
import System.Process
|
||||
import Test.Hspec
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = withOptions opts $ \ config logger statter -> hspec . parallel $ do
|
||||
let args = TaskConfig config logger statter
|
||||
|
||||
runIO setupExampleRepos
|
||||
|
||||
for_ languages $ \ lang@LanguageExample{..} -> do
|
||||
let tsDir = languagesDir </> languageName </> ("vendor/tree-sitter-" <> languageName)
|
||||
parallel . describe languageName $ parseExamples args lang tsDir
|
||||
|
||||
where
|
||||
parseExamples (TaskConfig config logger statter) LanguageExample{..} tsDir = do
|
||||
knownFailures <- runIO $ knownFailuresForPath tsDir languageKnownFailuresTxt
|
||||
files <- runIO $ globDir1 (compile ("**/*" <> languageExtension)) (tsDir </> languageExampleDir)
|
||||
for_ files $ \file -> it file $ do
|
||||
res <- runTaskWithConfig config logger statter (parseFilePath file)
|
||||
case res of
|
||||
Left (SomeException e) -> case cast e of
|
||||
-- We have a number of known assignment timeouts, consider these pending specs instead of failing the build.
|
||||
Just (AssignmentTimedOut _ _) -> pendingWith $ show (displayException e)
|
||||
-- Other exceptions are true failures
|
||||
_ -> expectationFailure (show (displayException e))
|
||||
_ -> if file `elem` knownFailures
|
||||
then pendingWith $ "Known parse failures " <> show (const "Assignment: OK" <$> res)
|
||||
else res `shouldSatisfy` isRight
|
||||
|
||||
setupExampleRepos = readProcess "script/clone-example-repos" mempty mempty >>= print
|
||||
opts = defaultOptions { optionsFailOnWarning = True, optionsLogLevel = Nothing }
|
||||
|
||||
knownFailuresForPath :: FilePath -> Maybe FilePath -> IO [FilePath]
|
||||
knownFailuresForPath _ Nothing = pure []
|
||||
knownFailuresForPath tsDir (Just path) = do
|
||||
known <- BC.lines <$> B.readFile (tsDir </> path)
|
||||
pure $ (tsDir </>) . BC.unpack <$> stripComments known
|
||||
where stripComments = filter (\line -> not (BC.null line) && BC.head line == '#')
|
||||
|
||||
data LanguageExample
|
||||
= LanguageExample
|
||||
{ languageName :: FilePath
|
||||
, languageExtension :: FilePath
|
||||
, languageExampleDir :: FilePath
|
||||
, languageKnownFailuresTxt :: Maybe FilePath
|
||||
} deriving (Eq, Show)
|
||||
|
||||
le :: FilePath -> FilePath -> FilePath -> Maybe FilePath -> LanguageExample
|
||||
le = LanguageExample
|
||||
|
||||
languages :: [LanguageExample]
|
||||
languages =
|
||||
[ le "python" ".py" "examples" (Just "script/known_failures.txt")
|
||||
, le "go" ".go" "examples" (Just "script/known-failures.txt")
|
||||
, le "ruby" ".rb" "examples" (Just "script/known_failures.txt")
|
||||
, le "typescript" ".ts" "examples" (Just "script/known_failures.txt")
|
||||
, le "typescript" ".js" "examples" Nothing -- parse JavaScript with TypeScript parser.
|
||||
|
||||
-- TODO: Java assignment errors need to be investigated
|
||||
-- , le "java" ".java" "examples/guava" (Just "script/known_failures_guava.txt")
|
||||
-- , le "java" ".java" "examples/elasticsearch" (Just "script/known_failures_elasticsearch.txt")
|
||||
-- , le "java" ".java" "examples/RxJava" (Just "script/known_failures_RxJava.txt")
|
||||
|
||||
-- TODO: Haskell assignment errors need to be investigated
|
||||
-- , le "haskell" ".hs" "examples/effects" (Just "script/known-failures-effects.txt")
|
||||
-- , le "haskell" ".hs" "examples/postgrest" (Just "script/known-failures-postgrest.txt")
|
||||
-- , le "haskell" ".hs" "examples/ivory" (Just "script/known-failures-ivory.txt")
|
||||
|
||||
-- , ("php", ".php") -- TODO: No parse-examples in tree-sitter yet
|
||||
]
|
||||
|
||||
parseFilePath :: (Member (Exc SomeException) effs, Member Task effs, Member IO.Files effs) => FilePath -> Eff effs Bool
|
||||
parseFilePath path = readBlob (file path) >>= runParse' >>= const (pure True)
|
||||
|
||||
languagesDir :: FilePath
|
||||
languagesDir = "vendor/haskell-tree-sitter/languages"
|
@ -6,12 +6,13 @@
|
||||
{+(Identifier)+}
|
||||
(Identifier)
|
||||
{-(Identifier)-})
|
||||
{ (If
|
||||
{-(Identifier)-}
|
||||
(Statements
|
||||
{-(If
|
||||
{-(Identifier)-}
|
||||
{-(Statements
|
||||
{-(Identifier)-}
|
||||
{-(Identifier)-})-}
|
||||
{-(Statements)-})-}
|
||||
{-(Statements
|
||||
{-(Identifier)-}
|
||||
{-(Identifier)-})-}
|
||||
{-(Statements
|
||||
{-(Identifier)-}
|
||||
{-(Identifier)-})-})
|
||||
->(Empty) }))
|
||||
{-(Identifier)-})-})))
|
||||
|
@ -6,12 +6,13 @@
|
||||
{-(Identifier)-}
|
||||
(Identifier)
|
||||
{+(Identifier)+})
|
||||
{ (Empty)
|
||||
->(If
|
||||
{+(Identifier)+}
|
||||
(Statements
|
||||
{+(If
|
||||
{+(Identifier)+}
|
||||
{+(Statements
|
||||
{+(Identifier)+}
|
||||
{+(Identifier)+})+}
|
||||
{+(Statements)+})+}
|
||||
{+(Statements
|
||||
{+(Identifier)+}
|
||||
{+(Identifier)+})+}
|
||||
{+(Statements
|
||||
{+(Identifier)+}
|
||||
{+(Identifier)+})+}) }))
|
||||
{+(Identifier)+})+})))
|
||||
|
@ -4,11 +4,13 @@
|
||||
(Statements
|
||||
(Identifier)
|
||||
(Identifier))
|
||||
(If
|
||||
(Identifier)
|
||||
(Statements
|
||||
(Statements
|
||||
(If
|
||||
(Identifier)
|
||||
(Identifier))
|
||||
(Statements
|
||||
(Identifier)
|
||||
(Identifier))
|
||||
(Statements))
|
||||
(Statements
|
||||
(Identifier)
|
||||
(Identifier)))))
|
||||
|
@ -4,4 +4,4 @@
|
||||
(Statements
|
||||
(Identifier)
|
||||
(Identifier))
|
||||
(Empty)))
|
||||
(Statements)))
|
||||
|
2
vendor/haskell-tree-sitter
vendored
2
vendor/haskell-tree-sitter
vendored
@ -1 +1 @@
|
||||
Subproject commit 09ff8a81cd92a696939eb82e0c33111bde3f0376
|
||||
Subproject commit f6916c009732b8b1195a05c13942b39cd8bf6829
|
Loading…
Reference in New Issue
Block a user