FIX #2521: trailing colon in GHC_PACKAGE_PATH

[ghc-hetmet.git] / utils / ghc-pkg / Main.hs

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index a9cb9f3..e204dbc 100644 (file)
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -43,13 +43,7 @@ import System.Exit ( exitWith, ExitCode(..) )
 import System.Environment ( getArgs, getProgName, getEnv )
 import System.IO
 import System.IO.Error (try)
-import Data.List ( isPrefixOf, isSuffixOf, intersperse, sortBy, nub,
-                   unfoldr, break, partition )
-#if __GLASGOW_HASKELL__ > 604
-import Data.List ( isInfixOf )
-#else
-import Data.List ( tails )
-#endif
+import Data.List
 import Control.Concurrent
 
 #ifdef mingw32_HOST_OS
@@ -432,7 +426,7 @@ getPkgDatabases modify my_flags = do
                 Right path
                   | last cs == ""  -> init cs ++ sys_databases
                   | otherwise      -> cs
-                  where cs = splitSearchPath path
+                  where cs = parseSearchPath path
 
         -- The "global" database is always the one at the bottom of the stack.
         -- This is the database we modify by default.
@@ -849,6 +843,7 @@ validatePackageConfig pkg db_stack auto_ghci_libs update force = do
   checkPackageId pkg
   checkDuplicates db_stack pkg update force
   mapM_ (checkDep db_stack force) (depends pkg)
+  checkDuplicateDepends force (depends pkg)
   mapM_ (checkDir force) (importDirs pkg)
   mapM_ (checkDir force) (libraryDirs pkg)
   mapM_ (checkDir force) (includeDirs pkg)
@@ -916,6 +911,14 @@ checkDep db_stack force pkgid
         all_pkgs = allPackagesInStack db_stack
         pkgids = map package all_pkgs
 
+checkDuplicateDepends :: Force -> [PackageIdentifier] -> IO ()
+checkDuplicateDepends force deps
+  | null dups = return ()
+  | otherwise = dieOrForceAll force ("package has duplicate dependencies: " ++
+                                     unwords (map display dups))
+  where
+       dups = [ p | (p:_:_) <- group (sort deps) ]
+
 realVersion :: PackageIdentifier -> Bool
 realVersion pkgid = versionBranch (pkgVersion pkgid) /= []
 
@@ -1195,3 +1198,23 @@ writeFileAtomic targetFile content = do
     --TODO: remove this when takeDirectory/splitFileName is fixed
     --      to always return a valid dir
     (targetDir_,targetName) = splitFileName targetFile
+
+-- | 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