mirror of
https://github.com/github/semantic.git
synced 2024-12-30 02:14:20 +03:00
0fdef390b2
If this keeps whining, I'll remove the test, but let's try tripling the timeout interval first.
111 lines
3.8 KiB
Haskell
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" Unknown)
|
|
blobPath blob `shouldBe` "semantic.cabal"
|
|
|
|
it "throws for absent files" $ do
|
|
readFile (File "this file should not exist" Unknown) `shouldThrow` anyIOException
|
|
|
|
describe "readBlobPairsFromHandle" $ do
|
|
let a = sourceBlob "method.rb" Ruby "def foo; end"
|
|
let b = sourceBlob "method.rb" 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" Unknown "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 1500 (wait churn)
|
|
res `shouldBe` Nothing
|
|
|
|
TS.ts_parser_set_enabled p (CBool 0)
|
|
done <- timeout 1500 (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" 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
|