From 20c6bb6a676f41bd7e930ea776372f76a945d194 Mon Sep 17 00:00:00 2001
From: brandon s allbery kf8nh <allbery.b@gmail.com>
Date: Tue, 12 Sep 2023 16:07:14 -0400
Subject: [PATCH] avoid invalid filepaths on Windows
---
.../src/Test/QuickCheck/Instances/Cabal.hs | 27 +++++++++++++------
1 file changed, 19 insertions(+), 8 deletions(-)
diff --git a/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs b/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs
index 01a5d1d904..df6c87562c 100644
--- a/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs
+++ b/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs
@@ -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, isPrefixOf, isInfixOf)
import Data.List.NonEmpty (NonEmpty (..))
import Distribution.Utils.Generic (lowercase)
import Test.QuickCheck
@@ -503,14 +503,25 @@ shortListOf1 bound gen = sized $ \n -> do
vectorOf k gen
arbitraryShortToken :: Gen String
-arbitraryShortToken = arbitraryShortStringWithout "{}[]"
+arbitraryShortToken = arbitraryShortStringWithout "{}[]" (const True)
arbitraryShortPath :: Gen String
-arbitraryShortPath = arbitraryShortStringWithout "{}[],"
-
-arbitraryShortStringWithout :: String -> Gen String
-arbitraryShortStringWithout excludeChars =
- shortListOf1 5 $ elements [c | c <- ['#' .. '~' ], c `notElem` excludeChars ]
+arbitraryShortPath = arbitraryShortStringWithout "{}[],<>:|*?" (not . winDevice)
+ where
+ devices = ["con", "aux", "prn", "com", "lpt", "nul"]
+ winDevice :: String -> Bool
+ winDevice p = let p' = map toLower p in any (isDev p') devices
+ isDev :: String -> String -> Bool
+ isDev p s = s `isPrefixOf` p || ('\\' : s) `isInfixOf` p
+
+arbitraryShortStringWithout :: String -> (String -> Bool) -> Gen String
+arbitraryShortStringWithout excludeChars validp =
+ shortListOf1 5 $ elements (str 5)
+ where
+ str :: Int -> String
+ str 0 = error "could not generate valid string"
+ str n = let s = [c | c <- ['#' .. '~' ], c `notElem` excludeChars ]
+ in if validp s then s else str (n - 1)
-- |
intSqrt :: Int -> Int
--
GitLab