[commit: ghc] wip/merge: Refactor: use System.FilePath.splitSearchPath (d38c824)

[git at git.haskell.org]

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

On branch  : wip/merge
Link       : http://ghc.haskell.org/trac/ghc/changeset/d38c824ddafa3d7cb3180ad58f852731068efd72/ghc

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

commit d38c824ddafa3d7cb3180ad58f852731068efd72
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Tue Nov 18 22:17:47 2014 -0600

    Refactor: use System.FilePath.splitSearchPath
    
    Summary:
    To address #2521 ("Trailing colon on GHC_PACKAGE_PATH doesn't work with
    ghc-pkg"), we were using a custom version of splitSearchPath (e4f46f5de). This
    solution however caused issue #9698 ("GHC_PACKAGE_PATH should be more lenient
    for empty paths").
    
    This patch reverts back to System.FilePath.splitSearchPath (fixes #9698) and
    adresses (#2521) by testing for a trailing search path separators explicitly
    (instead of implicitly using empty search path elements).
    
    Empty paths are now allowed (ignored on Windows, interpreted as current
    directory on Posix systems), and trailing path separator still tack on the
    user and system package databases.
    
    Also update submodule filepath, which has a version of splitSearchPath which
    handles quotes in the same way as our custom version did.
    
    Test Plan:
    $ GHC_PACKAGE_PATH=/::/home: ./ghc-pkg list
    ...
    db stack: ["/",".","/home","<userdb>","<systemdb>"]
    ...
    
    Reviewers: austin
    
    Reviewed By: austin
    
    Subscribers: thomie, carter, simonmar
    
    Differential Revision: https://phabricator.haskell.org/D414
    
    GHC Trac Issues: #2521, #9698


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

d38c824ddafa3d7cb3180ad58f852731068efd72
 compiler/main/Packages.lhs |  9 +++------
 compiler/utils/Util.lhs    | 21 ---------------------
 libraries/filepath         |  2 +-
 utils/ghc-pkg/Main.hs      | 27 ++++-----------------------
 4 files changed, 8 insertions(+), 51 deletions(-)

diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 2f4a4d7..40b5e24 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -334,13 +334,10 @@ readPackageConfigs dflags = do
   let base_conf_refs = case e_pkg_path of
         Left _ -> system_conf_refs
         Right path
-         | null (last cs)
-         -> map PkgConfFile (init cs) ++ system_conf_refs
+         | not (null path) && isSearchPathSeparator (last path)
+         -> map PkgConfFile (splitSearchPath (init path)) ++ system_conf_refs
          | otherwise
-         -> map PkgConfFile cs
-         where cs = parseSearchPath path
-         -- if the path ends in a separator (eg. "/foo/bar:")
-         -- then we tack on the system paths.
+         -> map PkgConfFile (splitSearchPath path)
 
   let conf_refs = reverse (extraPkgConfs dflags base_conf_refs)
   -- later packages shadow earlier ones.  extraPkgConfs
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index aa5f6f9..df293f0 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -89,7 +89,6 @@ module Util (
         Suffix,
         splitLongestPrefix,
         escapeSpaces,
-        parseSearchPath,
         Direction(..), reslash,
         makeRelativeTo,
 
@@ -1005,26 +1004,6 @@ type Suffix = String
 -- * Search path
 --------------------------------------------------------------
 
--- | The function splits the given string to substrings
--- using the 'searchPathSeparator'.
-parseSearchPath :: String -> [FilePath]
-parseSearchPath path = split path
-  where
-    split :: String -> [String]
-    split s =
-      case rest' of
-        []     -> [chunk]
-        _:rest -> chunk : split rest
-      where
-        chunk =
-          case chunk' of
-#ifdef mingw32_HOST_OS
-            ('\"':xs@(_:_)) | last xs == '\"' -> init xs
-#endif
-            _                                 -> chunk'
-
-        (chunk', rest') = break isSearchPathSeparator s
-
 data Direction = Forwards | Backwards
 
 reslash :: Direction -> FilePath -> FilePath
diff --git a/libraries/filepath b/libraries/filepath
index 7011e20..83b6d8c 160000
--- a/libraries/filepath
+++ b/libraries/filepath
@@ -1 +1 @@
-Subproject commit 7011e20dbe30f96f34f6cfb1fd3f3aad9e7a6534
+Subproject commit 83b6d8c555d278f5bb79cef6661d02bc38e72c1e
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index a67dbb2..b1c7a4b 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -600,9 +600,10 @@ getPkgDatabases verbosity modify use_user use_cache expand_vars my_flags = do
         case e_pkg_path of
                 Left  _ -> sys_databases
                 Right path
-                  | last cs == ""  -> init cs ++ sys_databases
-                  | otherwise      -> cs
-                  where cs = parseSearchPath path
+                  | not (null path) && isSearchPathSeparator (last path)
+                  -> splitSearchPath (init path) ++ sys_databases
+                  | otherwise
+                  -> splitSearchPath path
 
         -- The "global" database is always the one at the bottom of the stack.
         -- This is the database we modify by default.
@@ -2006,26 +2007,6 @@ openNewFile dir template = do
   -- in binary mode.
   openTempFileWithDefaultPermissions dir template
 
--- | The function splits the given string to substrings
--- using 'isSearchPathSeparator'.
-parseSearchPath :: String -> [FilePath]
-parseSearchPath path = split path
-  where
-    split :: String -> [String]
-    split s =
-      case rest' of
-        []     -> [chunk]
-        _:rest -> chunk : split rest
-      where
-        chunk =
-          case chunk' of
-#ifdef mingw32_HOST_OS
-            ('\"':xs@(_:_)) | last xs == '\"' -> init xs
-#endif
-            _                                 -> chunk'
-
-        (chunk', rest') = break isSearchPathSeparator s
-
 readUTF8File :: FilePath -> IO String
 readUTF8File file = do
   h <- openFile file ReadMode