avoid providing filename with NUL to quickcheck properties

instance Arbitrary [Char] allows that, and it's not a legal part of a
filename so can break processing them.

Noticed when prop_view_roundtrips failed.

The instance Arbitrary AssociatedFile avoids this problem.

This commit was sponsored by Mark Reidenbach on Patreon.
This commit is contained in:
Joey Hess 2020-11-06 15:13:14 -04:00
parent 1db49497e0
commit 907a0bcad6
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 8 additions and 5 deletions

View file

@ -39,6 +39,7 @@ import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.Set as S
import qualified Data.Map as M
import qualified System.FilePath.ByteString as P
import "mtl" Control.Monad.Writer
{- Each visible ViewFilter in a view results in another level of
@ -293,12 +294,12 @@ fromView view f = MetaData $
- it to a file yields a set of ViewedFile which all contain the same
- MetaFields that were present in the input metadata
- (excluding fields that are not visible). -}
prop_view_roundtrips :: FilePath -> MetaData -> Bool -> Bool
prop_view_roundtrips f metadata visible = or
[ null f
, null (takeFileName f) && null (takeDirectory f)
prop_view_roundtrips :: AssociatedFile -> MetaData -> Bool -> Bool
prop_view_roundtrips (AssociatedFile Nothing) _ _ = True
prop_view_roundtrips (AssociatedFile (Just f)) metadata visible = or
[ B.null (P.takeFileName f) && B.null (P.takeDirectory f)
, viewTooLarge view
, all hasfields (viewedFiles view viewedFileFromReference f metadata)
, all hasfields (viewedFiles view viewedFileFromReference (fromRawFilePath f) metadata)
]
where
view = View (Git.Ref "foo") $

View file

@ -88,6 +88,7 @@ upFrom dir
prop_upFrom_basics :: FilePath -> Bool
prop_upFrom_basics dir
| null dir = True
| '\NUL' `elem` dir = True -- not a legal filename
| dir == "/" = p == Nothing
| otherwise = p /= Just dir
where
@ -226,6 +227,7 @@ relPathDirToFileAbs from to
prop_relPathDirToFileAbs_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFileAbs_basics from to
| null from || null to = True
| '\NUL' `elem` from || '\NUL' `elem` to = True -- not a legal filename
| from == to = null r
| otherwise = not (null r)
where