github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-03 00:16:52 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #222 from github/source-coverage-guarantees

Browse Source 
Source coverage “guarantees”
This commit is contained in:
Patrick Thomson 2019-08-07 10:47:30 -04:00 committed by GitHub
commit 8a8c2baceb
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 16 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
test/Data/Source/Spec.hs
View File

@ -8,10 +8,9 @@ import qualified Data.Text as Text
import Test.Hspec
import qualified Generators as Gen
import qualified Hedgehog.Gen as Gen
import Hedgehog ((===), label)
import qualified Hedgehog.Range
import Hedgehog hiding (Range)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range
import qualified Test.Tasty as Tasty
import Test.Tasty.Hedgehog (testProperty)
@ -25,14 +24,12 @@ prop desc f
testTree :: Tasty.TestTree
testTree = Tasty.testGroup "Data.Source"
[ Tasty.testGroup "sourceLineRanges"
[ testProperty "produces 1 more range than there are newlines" $ property $ do
source <- forAll (Gen.source (Hedgehog.Range.linear 0 100))
label (summarize source)
(length (sourceLineRanges source) === length (Text.splitOn "\r\n" (toText source) >>= Text.splitOn "\r" >>= Text.splitOn "\n"))
[ prop "produces 1 more range than there are newlines" $ \ source -> do
summarize source
length (sourceLineRanges source) === length (Text.splitOn "\r\n" (toText source) >>= Text.splitOn "\r" >>= Text.splitOn "\n")
, testProperty "produces exhaustive ranges" $ property $ do
source <- forAll (Gen.source (Hedgehog.Range.linear 0 100))
label (summarize source)
, prop "produces exhaustive ranges" $ \ source -> do
summarize source
foldMap (`slice` source) (sourceLineRanges source) === source
]
@ -72,10 +69,12 @@ testTree = Tasty.testGroup "Data.Source"
]
]
where summarize src = case sourceLines src of
[] -> "empty"
[x] -> if nullSource x then "empty" else "single-line"
_ -> "multiple lines"
where summarize src = do
let lines = sourceLines src
-- FIXME: this should be using cover (reverted in 1b427b995), but that leads to flaky tests: hedgehog’s 'cover' implementation fails tests instead of warning, and currently has no equivalent to 'checkCoverage'.
classify "empty" $ nullSource src
classify "single-line" $ length lines == 1
classify "multiple lines" $ length lines > 1
spec :: Spec
spec = do

4
test/Generators.hs
View File

@ -9,4 +9,6 @@ import qualified Data.Source
import Data.Functor.Identity
source :: (GenBase m ~ Identity, MonadGen m) => Hedgehog.Range Int -> m Data.Source.Source
source r = Data.Source.fromUTF8 <$> Gen.utf8 r (Gen.frequency [ (1, pure '\r'), (1, pure '\n'), (20, Gen.unicode) ])
source r = Gen.frequency [ (1, empty), (20, nonEmpty) ]
where empty = pure mempty
nonEmpty = Data.Source.fromUTF8 <$> Gen.utf8 r (Gen.frequency [ (1, pure '\r'), (1, pure '\n'), (20, Gen.unicode) ])