Skip to content

avoid invalid filepaths on Windows #9254

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Sep 28, 2023
Merged

avoid invalid filepaths on Windows #9254

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
542fe32
avoid invalid filepaths on Windows
geekosaur Sep 12, 2023
a3e613f
comment bad Arbitrary instances
geekosaur Sep 21, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 17 additions & 4 deletions Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,8 +5,8 @@ module Test.QuickCheck.Instances.Cabal () where

import Control.Applicative (liftA2)
import Data.Bits (shiftR)
import Data.Char (isAlphaNum, isDigit)
import Data.List (intercalate)
import Data.Char (isAlphaNum, isDigit, toLower)
import Data.List (intercalate, (\\))
import Data.List.NonEmpty (NonEmpty (..))
import Distribution.Utils.Generic (lowercase)
import Test.QuickCheck
Expand Down Expand Up @@ -405,6 +405,10 @@ instance (Arbitrary a, Ord a) => Arbitrary (NubList a) where
-- InstallDirs
-------------------------------------------------------------------------------

-- these are wrong because they bottom out in String. We should really use
-- the modern FilePath at some point, so we get QC instances that don't include
-- invalid characters or path components

instance Arbitrary a => Arbitrary (InstallDirs a) where
arbitrary = InstallDirs
<$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -- 4
Expand Down Expand Up @@ -506,11 +510,20 @@ arbitraryShortToken :: Gen String
arbitraryShortToken = arbitraryShortStringWithout "{}[]"

arbitraryShortPath :: Gen String
arbitraryShortPath = arbitraryShortStringWithout "{}[],"
arbitraryShortPath = arbitraryShortStringWithout "{}[],<>:|*?" `suchThat` (not . winDevice)
where
-- split path components on dots
-- no component can be empty or a device name
-- this blocks a little too much (both "foo..bar" and "foo.con" are legal)
-- but for QC being a little conservative isn't harmful
winDevice = any (any (`elem` ["","con", "aux", "prn", "com", "lpt", "nul"]) . splitBy ".") . splitBy "\\/" . map toLower
splitBy _ "" = []
splitBy seps str = let (part,rest) = break (`elem` seps) str
in part : if length rest == 1 then [""] else splitBy seps (drop 1 rest)

arbitraryShortStringWithout :: String -> Gen String
arbitraryShortStringWithout excludeChars =
shortListOf1 5 $ elements [c | c <- ['#' .. '~' ], c `notElem` excludeChars ]
shortListOf1 5 $ elements $ ['#' .. '~'] \\ excludeChars

-- |
intSqrt :: Int -> Int
Expand Down