Accept tests megapatch

.travis.yml

@@ -57,22 +57,15 @@ matrix:
    # We axed GHC 7.6 and earlier because it's not worth the trouble to
    # make older GHC work with clang's cpp.  See
    # https://ghc.haskell.org/trac/ghc/ticket/8493
-   - env: GHCVER=7.8.4 SCRIPT=script CABAL_LIB_ONLY=YES
+   - env: GHCVER=7.8.4 SCRIPT=script
      os: osx
      osx_image: xcode6.4 # We need 10.10
-   - env: GHCVER=7.8.4 SCRIPT=script CABAL_INSTALL_ONLY=YES
-     os: osx
-     osx_image: xcode6.4
 
    # TODO: We might want to specify OSX version
    # https://docs.travis-ci.com/user/osx-ci-environment/#OS-X-Version
-   - env: GHCVER=7.10.3 SCRIPT=script CABAL_LIB_ONLY=YES
-     os: osx
-   - env: GHCVER=7.10.3 SCRIPT=script CABAL_INSTALL_ONLY=YES
-     os: osx
-   - env: GHCVER=8.0.1 SCRIPT=script CABAL_LIB_ONLY=YES
+   - env: GHCVER=7.10.3 SCRIPT=script
      os: osx
-   - env: GHCVER=8.0.1 SCRIPT=script CABAL_INSTALL_ONLY=YES
+   - env: GHCVER=8.0.1 SCRIPT=script
      os: osx
    - env: GHCVER=8.0.1 SCRIPT=bootstrap
      os: osx

Cabal/Cabal.cabal

@@ -120,6 +120,7 @@ library
     Distribution.Backpack.Configure
     Distribution.Backpack.ComponentsGraph
     Distribution.Backpack.ConfiguredComponent
+    Distribution.Backpack.DescribeUnitId
     Distribution.Backpack.FullUnitId
     Distribution.Backpack.LinkedComponent
     Distribution.Backpack.ModSubst

Cabal/Distribution/Backpack/Configure.hs

@@ -42,7 +42,6 @@ import Distribution.Types.ComponentInclude
 import Distribution.Verbosity
 import qualified Distribution.Compat.Graph as Graph
 import Distribution.Compat.Graph (Graph, IsNode(..))
-import Distribution.Utils.Progress
 import Distribution.Utils.LogProgress
 
 import Data.Either
@@ -60,6 +59,7 @@ configureComponentLocalBuildInfos
     :: Verbosity
     -> Bool                   -- use_external_internal_deps
     -> ComponentRequestedSpec
+    -> Bool                   -- deterministic
     -> Flag String            -- configIPID
     -> Flag ComponentId       -- configCID
     -> PackageDescription
@@ -70,12 +70,12 @@ configureComponentLocalBuildInfos
     -> Compiler
     -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
 configureComponentLocalBuildInfos
-    verbosity use_external_internal_deps enabled ipid_flag cid_flag pkg_descr
+    verbosity use_external_internal_deps enabled deterministic ipid_flag cid_flag pkg_descr
     prePkgDeps flagAssignment instantiate_with installedPackageSet comp = do
     -- NB: In single component mode, this returns a *single* component.
     -- In this graph, the graph is NOT closed.
     graph0 <- case toComponentsGraph enabled pkg_descr of
-                Left ccycle -> failProgress (componentCycleMsg ccycle)
+                Left ccycle -> dieProgress (componentCycleMsg ccycle)
                 Right comps -> return comps
     infoProgress $ hang (text "Source component graph:") 4
                         (dispComponentsGraph graph0)
@@ -85,7 +85,7 @@ configureComponentLocalBuildInfos
             | pkg <- prePkgDeps]
         graph1 = toConfiguredComponents use_external_internal_deps
                     flagAssignment
-                    ipid_flag cid_flag pkg_descr
+                    deterministic ipid_flag cid_flag pkg_descr
                     conf_pkg_map (map fst graph0)
     infoProgress $ hang (text "Configured component graph:") 4
                         (vcat (map dispConfiguredComponent graph1))
@@ -172,7 +172,7 @@ toComponentLocalBuildInfos
         [] -> return ()
         broken ->
           -- TODO: ppr this
-          failProgress . text $
+          dieProgress . text $
                 "The following packages are broken because other"
              ++ " packages they depend on are missing. These broken "
              ++ "packages must be rebuilt before they can be used.\n"

Cabal/Distribution/Backpack/ConfiguredComponent.hs

@@ -2,6 +2,7 @@
 -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
 module Distribution.Backpack.ConfiguredComponent (
     ConfiguredComponent(..),
+    cc_name,
     toConfiguredComponent,
     toConfiguredComponents,
     dispConfiguredComponent,
@@ -98,10 +99,9 @@ mkConfiguredComponent this_pid this_cid lib_deps exe_deps component =
     }
   where
     bi = componentBuildInfo component
-    deps = map snd lib_deps
     deps_map = Map.fromList lib_deps
 
-    -- Resolve each @backpack-include@ into the actual dependency
+    -- Resolve each @mixins@ into the actual dependency
     -- from @lib_deps@.
     explicit_includes
         = [ let (cid, pid) =
@@ -112,22 +112,27 @@ mkConfiguredComponent this_pid this_cid lib_deps exe_deps component =
                         Just r  -> r
             in ComponentInclude {
                 ci_id       = cid,
-                -- TODO: Check what breaks if you remove this edit
+                -- TODO: We set pkgName = name here to make error messages
+                -- look better. But it would be better to properly
+                -- record component name here.
                 ci_pkgid    = pid { pkgName = name },
-                ci_renaming = rns
+                ci_renaming = rns,
+                ci_implicit = False
                }
           | Mixin name rns <- mixins bi ]
 
     -- Any @build-depends@ which is not explicitly mentioned in
     -- @backpack-include@ is converted into an "implicit" include.
     used_explicitly = Set.fromList (map ci_id explicit_includes)
     implicit_includes
-        = map (\(cid, pid) -> ComponentInclude {
+        = map (\(pn, (cid, pid)) -> ComponentInclude {
                                 ci_id = cid,
-                                ci_pkgid = pid,
-                                ci_renaming = defaultIncludeRenaming
+                                -- See above ci_pkgid
+                                ci_pkgid = pid { pkgName = pn },
+                                ci_renaming = defaultIncludeRenaming,
+                                ci_implicit = True
                               })
-        $ filter (flip Set.notMember used_explicitly . fst) deps
+        $ filter (flip Set.notMember used_explicitly . fst . snd) lib_deps
 
     is_public = componentName component == CLibName
 
@@ -178,14 +183,15 @@ toConfiguredComponent'
     :: Bool -- use_external_internal_deps
     -> FlagAssignment
     -> PackageDescription
+    -> Bool -- deterministic
     -> Flag String      -- configIPID (todo: remove me)
     -> Flag ComponentId -- configCID
     -> Map PackageName (ComponentId, PackageId) -- external
     -> ConfiguredComponentMap
     -> Component
     -> ConfiguredComponent
 toConfiguredComponent' use_external_internal_deps flags
-                pkg_descr ipid_flag cid_flag
+                pkg_descr deterministic ipid_flag cid_flag
                 external_lib_map (lib_map, exe_map) component =
     let cc = toConfiguredComponent
                 pkg_descr this_cid
@@ -194,7 +200,7 @@ toConfiguredComponent' use_external_internal_deps flags
         then cc { cc_public = True }
         else cc
   where
-    this_cid = computeComponentId ipid_flag cid_flag (package pkg_descr)
+    this_cid = computeComponentId deterministic ipid_flag cid_flag (package pkg_descr)
                 (componentName component) (Just (deps, flags))
     deps = [ cid | (cid, _) <- Map.elems external_lib_map ]
 
@@ -227,20 +233,22 @@ extendConfiguredComponentMap cc (lib_map, exe_map) =
 toConfiguredComponents
     :: Bool -- use_external_internal_deps
     -> FlagAssignment
+    -> Bool -- deterministic
     -> Flag String -- configIPID
     -> Flag ComponentId -- configCID
     -> PackageDescription
     -> Map PackageName (ComponentId, PackageId)
     -> [Component]
     -> [ConfiguredComponent]
 toConfiguredComponents
-    use_external_internal_deps flags ipid_flag cid_flag pkg_descr
+    use_external_internal_deps flags deterministic ipid_flag cid_flag pkg_descr
     external_lib_map comps
     = snd (mapAccumL go (Map.empty, Map.empty) comps)
   where
     go m component = (extendConfiguredComponentMap cc m, cc)
       where cc = toConfiguredComponent'
-                        use_external_internal_deps flags pkg_descr ipid_flag cid_flag
+                        use_external_internal_deps flags pkg_descr
+                        deterministic ipid_flag cid_flag
                         external_lib_map m component
 
 

Cabal/Distribution/Backpack/DescribeUnitId.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Distribution.Backpack.DescribeUnitId where
+
+import Prelude ()
+import Distribution.Compat.Prelude
+
+import Distribution.Types.ComponentName
+import Distribution.Compat.Stack
+import Distribution.Verbosity
+import Distribution.ModuleName
+import Distribution.Package
+import Distribution.Text
+import Distribution.Simple.Utils
+
+import Text.PrettyPrint
+
+-- Unit identifiers have a well defined, machine-readable format,
+-- but this format isn't very user-friendly for users.  This
+-- module defines some functions for solving common rendering
+-- problems one has for displaying these.
+--
+-- There are three basic problems we tackle:
+--
+--  - Users don't want to see pkg-0.5-inplace-libname,
+--    they want to see "library 'libname' from 'pkg-0.5'"
+--
+--  - Users don't want to see the raw component identifier, which
+--    usually contains a wordy hash that doesn't matter.
+--
+--  - Users don't want to see a hash of the instantiation: they
+--    want to see the actual instantiation, and they want it in
+--    interpretable form.
+--
+
+-- | Print a Setup message stating (1) what operation we are doing,
+-- for (2) which component (with enough details to uniquely identify
+-- the build in question.)
+--
+setupMessage' :: Text a => Verbosity
+             -> String            -- ^ Operation being done (capitalized), on:
+             -> PackageIdentifier -- ^ Package
+             -> ComponentName     -- ^ Component name
+             -> Maybe [(ModuleName, a)] -- ^ Instantiation, if available.
+                                        -- Polymorphic to take
+                                        -- 'OpenModule' or 'Module'
+             -> IO ()
+setupMessage' verbosity msg pkgid cname mb_insts = withFrozenCallStack $ do
+    noticeDoc verbosity $
+      case mb_insts of
+        Just insts | not (null insts) ->
+          hang (msg_doc <+> text "instantiated with") 2
+               (vcat [ disp k <+> text "=" <+> disp v
+                     | (k,v) <- insts ]) $$
+          for_doc
+        _ ->
+          msg_doc <+> for_doc
+
+  where
+    msg_doc = text msg <+> text (showComponentName cname)
+    for_doc = text "for" <+> disp pkgid <<>> text ".."

Cabal/Distribution/Backpack/Id.hs

@@ -28,14 +28,15 @@ import Distribution.Text
 -- for a package.  The intent is that cabal-install (or the user) will
 -- specify a more detailed IPID via the @--ipid@ flag if necessary.
 computeComponentId
-    :: Flag String
+    :: Bool -- deterministic mode
+    -> Flag String
     -> Flag ComponentId
     -> PackageIdentifier
     -> ComponentName
     -- This is used by cabal-install's legacy codepath
     -> Maybe ([ComponentId], FlagAssignment)
     -> ComponentId
-computeComponentId mb_ipid mb_cid pid cname mb_details =
+computeComponentId deterministic mb_ipid mb_cid pid cname mb_details =
     -- show is found to be faster than intercalate and then replacement of
     -- special character used in intercalating. We cannot simply hash by
     -- doubly concating list, as it just flatten out the nested list, so
@@ -58,7 +59,8 @@ computeComponentId mb_ipid mb_cid pid cname mb_details =
           where env = packageTemplateEnv pid (mkUnitId "")
         actual_base = case mb_ipid of
                         Flag ipid0 -> explicit_base ipid0
-                        NoFlag -> generated_base
+                        NoFlag | deterministic -> display pid
+                               | otherwise     -> generated_base
     in case mb_cid of
           Flag cid -> cid
           NoFlag -> mkComponentId $ actual_base