[commit: packages/filepath] master: #47, isValid now detects invalid files like "nul .txt" on Windows (71f02bc)

git at git.haskell.org git at git.haskell.org
Mon Dec 28 20:40:08 UTC 2015


Repository : ssh://git@git.haskell.org/filepath

On branch  : master
Link       : http://git.haskell.org/packages/filepath.git/commitdiff/71f02bc8decfe4561cbd30946e62116e75b6dafd

>---------------------------------------------------------------

commit 71f02bc8decfe4561cbd30946e62116e75b6dafd
Author: Neil Mitchell <ndmitchell at gmail.com>
Date:   Tue Dec 22 11:43:16 2015 +0000

    #47, isValid now detects invalid files like "nul .txt" on Windows


>---------------------------------------------------------------

71f02bc8decfe4561cbd30946e62116e75b6dafd
 System/FilePath/Internal.hs | 7 +++++--
 changelog.md                | 2 ++
 tests/TestGen.hs            | 3 +++
 3 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs
index 30ee372..8f0acdd 100644
--- a/System/FilePath/Internal.hs
+++ b/System/FilePath/Internal.hs
@@ -872,6 +872,8 @@ badElements =
 -- > Windows: isValid "\\\\\\foo" == False
 -- > Windows: isValid "\\\\?\\D:file" == False
 -- > Windows: isValid "foo\tbar" == False
+-- > Windows: isValid "nul .txt" == False
+-- > Windows: isValid " nul.txt" == True
 isValid :: FilePath -> Bool
 isValid "" = False
 isValid x | '\0' `elem` x = False
@@ -883,7 +885,7 @@ isValid path =
         not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1))
     where
         (x1,x2) = splitDrive path
-        f x = map toUpper (dropExtensions x) `elem` badElements
+        f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements
 
 
 -- | Take a FilePath and make it valid; does not change already valid FilePaths.
@@ -901,6 +903,7 @@ isValid path =
 -- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"
 -- > Windows: makeValid "\\\\\\foo" == "\\\\drive"
 -- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file"
+-- > Windows: makeValid "nul .txt" == "nul _.txt"
 makeValid :: FilePath -> FilePath
 makeValid "" = "_"
 makeValid path
@@ -918,7 +921,7 @@ makeValid path
         validElements x = joinPath $ map g $ splitPath x
         g x = h a ++ b
             where (a,b) = break isPathSeparator x
-        h x = if map toUpper a `elem` badElements then a ++ "_" <.> b else x
+        h x = if map toUpper (dropWhileEnd (== ' ') a) `elem` badElements then a ++ "_" <.> b else x
             where (a,b) = splitExtensions x
 
 
diff --git a/changelog.md b/changelog.md
index 4e753af..e749e3f 100644
--- a/changelog.md
+++ b/changelog.md
@@ -4,6 +4,8 @@ _Note: below all `FilePath` values are unquoted, so `\\` really means two backsl
 
 ## 1.4.1.0  *Unreleased*
 
+ * Make `isValid` detect more invalid Windows paths, e.g. `nul .txt` and `foo\nbar`.
+
  * Improve the documentation.
 
  * Bug fix: `isValid "\0"` now returns `False`, instead of `True`
diff --git a/tests/TestGen.hs b/tests/TestGen.hs
index c3b1acd..ead85d8 100755
--- a/tests/TestGen.hs
+++ b/tests/TestGen.hs
@@ -385,6 +385,8 @@ tests =
     ,("W.isValid \"\\\\\\\\\\\\foo\" == False", test $ W.isValid "\\\\\\foo" == False)
     ,("W.isValid \"\\\\\\\\?\\\\D:file\" == False", test $ W.isValid "\\\\?\\D:file" == False)
     ,("W.isValid \"foo\\tbar\" == False", test $ W.isValid "foo\tbar" == False)
+    ,("W.isValid \"nul .txt\" == False", test $ W.isValid "nul .txt" == False)
+    ,("W.isValid \" nul.txt\" == True", test $ W.isValid " nul.txt" == True)
     ,("P.isValid (P.makeValid x)", test $ \(QFilePath x) -> P.isValid (P.makeValid x))
     ,("W.isValid (W.makeValid x)", test $ \(QFilePath x) -> W.isValid (W.makeValid x))
     ,("P.isValid x ==> P.makeValid x == x", test $ \(QFilePath x) -> P.isValid x ==> P.makeValid x == x)
@@ -402,6 +404,7 @@ tests =
     ,("W.makeValid \"c:\\\\nul\\\\file\" == \"c:\\\\nul_\\\\file\"", test $ W.makeValid "c:\\nul\\file" == "c:\\nul_\\file")
     ,("W.makeValid \"\\\\\\\\\\\\foo\" == \"\\\\\\\\drive\"", test $ W.makeValid "\\\\\\foo" == "\\\\drive")
     ,("W.makeValid \"\\\\\\\\?\\\\D:file\" == \"\\\\\\\\?\\\\D:\\\\file\"", test $ W.makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file")
+    ,("W.makeValid \"nul .txt\" == \"nul _.txt\"", test $ W.makeValid "nul .txt" == "nul _.txt")
     ,("W.isRelative \"path\\\\test\" == True", test $ W.isRelative "path\\test" == True)
     ,("W.isRelative \"c:\\\\test\" == False", test $ W.isRelative "c:\\test" == False)
     ,("W.isRelative \"c:test\" == True", test $ W.isRelative "c:test" == True)



More information about the ghc-commits mailing list