1
1
mirror of https://github.com/github/semantic.git synced 2024-12-26 08:25:19 +03:00
semantic/test/Semantic/IO/Spec.hs
Patrick Thomson f563a2c808 forgot a do
2018-05-22 17:25:17 -04:00

111 lines
3.8 KiB
Haskell

module Semantic.IO.Spec (spec) where
import Prelude hiding (readFile)
import Control.Concurrent.Async
import Foreign
import Foreign.C.Types (CBool (..))
import Semantic.IO
import System.Exit (ExitCode (..))
import System.IO (IOMode (..))
import Parsing.TreeSitter
import System.Timeout
import qualified TreeSitter.Language as TS
import qualified TreeSitter.Node as TS
import qualified TreeSitter.Parser as TS
import qualified TreeSitter.Tree as TS
import SpecHelpers
spec :: Spec
spec = parallel $ do
describe "readFile" $ do
it "returns a blob for extant files" $ do
Just blob <- readFile (File "semantic.cabal" Nothing)
blobPath blob `shouldBe` "semantic.cabal"
it "throws for absent files" $ do
readFile (File "this file should not exist" Nothing) `shouldThrow` anyIOException
describe "readBlobPairsFromHandle" $ do
let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
let b = sourceBlob "method.rb" (Just Ruby) "def bar(x); end"
it "returns blobs for valid JSON encoded diff input" $ do
blobs <- blobsFromFilePath "test/fixtures/cli/diff.json"
blobs `shouldBe` [blobPairDiffing a b]
it "returns blobs when there's no before" $ do
blobs <- blobsFromFilePath "test/fixtures/cli/diff-no-before.json"
blobs `shouldBe` [blobPairInserting b]
it "returns blobs when there's null before" $ do
blobs <- blobsFromFilePath "test/fixtures/cli/diff-null-before.json"
blobs `shouldBe` [blobPairInserting b]
it "returns blobs when there's no after" $ do
blobs <- blobsFromFilePath "test/fixtures/cli/diff-no-after.json"
blobs `shouldBe` [blobPairDeleting a]
it "returns blobs when there's null after" $ do
blobs <- blobsFromFilePath "test/fixtures/cli/diff-null-after.json"
blobs `shouldBe` [blobPairDeleting a]
it "returns blobs for unsupported language" $ do
h <- openFileForReading "test/fixtures/cli/diff-unsupported-language.json"
blobs <- readBlobPairsFromHandle h
let b' = sourceBlob "test.kt" Nothing "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
blobs `shouldBe` [blobPairInserting b']
it "detects language based on filepath for empty language" $ do
blobs <- blobsFromFilePath "test/fixtures/cli/diff-empty-language.json"
blobs `shouldBe` [blobPairDiffing a b]
it "throws on blank input" $ do
h <- openFileForReading "test/fixtures/cli/blank.json"
readBlobPairsFromHandle h `shouldThrow` (== ExitFailure 1)
it "throws if language field not given" $ do
h <- openFileForReading "test/fixtures/cli/diff-no-language.json"
readBlobsFromHandle h `shouldThrow` (== ExitFailure 1)
it "throws if null on before and after" $ do
h <- openFileForReading "test/fixtures/cli/diff-null-both-sides.json"
readBlobPairsFromHandle h `shouldThrow` (== ExitFailure 1)
describe "cancelable parsing" $
it "should be cancelable asynchronously" $ do
p <- TS.ts_parser_new
churn <- async $ do
TS.ts_parser_loop_until_cancelled p nullPtr nullPtr 0
pure True
res <- timeout 500 (wait churn)
res `shouldBe` Nothing
TS.ts_parser_set_enabled p (CBool 0)
done <- timeout 500 (wait churn)
done `shouldBe` (Just True)
TS.ts_parser_delete p
describe "readBlobsFromHandle" $ do
it "returns blobs for valid JSON encoded parse input" $ do
h <- openFileForReading "test/fixtures/cli/parse.json"
blobs <- readBlobsFromHandle h
let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
blobs `shouldBe` [a]
it "throws on blank input" $ do
h <- openFileForReading "test/fixtures/cli/blank.json"
readBlobsFromHandle h `shouldThrow` (== ExitFailure 1)
where blobsFromFilePath path = do
h <- openFileForReading path
blobs <- readBlobPairsFromHandle h
pure blobs