diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index e3a751619a47ee605f93373fd511ce70aea4705e..9ed541add99410cee61599344409e69466b5ee72 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -3223,9 +3223,6 @@ setRootTargets targetAction perPkgTargetsMap = | isSubLibComponentTarget tgt = elab{elabHaddockInternal = True} | otherwise = elab -minVersionReplFlagFile :: Version -minVersionReplFlagFile = mkVersion [3, 9] - -- | Assuming we have previously set the root build targets (i.e. the user -- targets but not rev deps yet), the first pruning pass does two things: -- @@ -3240,7 +3237,7 @@ pruneInstallPlanPass1 pruneInstallPlanPass1 pkgs -- if there are repl targets, we need to do a bit more work -- See Note [Pruning for Multi Repl] - | anyReplTarget = final_final_graph + | anyMultiReplTarget = graph_with_repl_targets -- otherwise we'll do less | otherwise = pruned_packages where @@ -3264,10 +3261,11 @@ pruneInstallPlanPass1 pkgs closed_graph :: Graph.Graph ElaboratedPlanPackage closed_graph = Graph.fromDistinctList pruned_packages - -- whether any package has repl targets enabled. - anyReplTarget :: Bool - anyReplTarget = any is_repl_gpp pkgs' + -- whether any package has repl targets enabled, and we need to use multi-repl. + anyMultiReplTarget :: Bool + anyMultiReplTarget = length repls > 1 where + repls = filter is_repl_gpp pkgs' is_repl_gpp (InstallPlan.Configured pkg) = is_repl_pp pkg is_repl_gpp _ = False @@ -3290,52 +3288,9 @@ pruneInstallPlanPass1 pkgs -- Add the repl target information to the ElaboratedPlanPackages graph_with_repl_targets - | anyReplTarget = map (mapConfiguredPackage add_repl_target) (Graph.toList closed_graph) + | anyMultiReplTarget = map (mapConfiguredPackage add_repl_target) (Graph.toList closed_graph) | otherwise = Graph.toList closed_graph - -- But check that all the InMemory targets have a new enough version of Cabal, - -- otherwise we will confuse Setup.hs by passing new arguments which it doesn't understand - -- later down the line. We try to remove just these edges, if it doesn't break the overall structure - -- then we just report to the user that their target will not be loaded for this reason. - -- - -- 'bad' are the nodes with a too old version of Cabal - -- 'good' are the nodes with a new-enough version of Cabal - (bad, _good) = partitionEithers (map go graph_with_repl_targets) - where - go :: ElaboratedPlanPackage -> Either UnitId ElaboratedPlanPackage - go (InstallPlan.Configured cp) - | BuildInplaceOnly InMemory <- elabBuildStyle cp - , elabSetupScriptCliVersion cp < minVersionReplFlagFile = - Left (elabUnitId cp) - go (InstallPlan.Configured c) = Right (InstallPlan.Configured c) - go c = Right c - - -- Now take the upwards closure from the bad nodes, and find the other `BuildInplaceOnly InMemory` packages that clobbers, - -- disables those and issue a warning to the user. Because we aren't going to be able to load those into memory as well - -- because the thing it depends on is not going to be in memory. - disabled_repl_targets = - [ c | InstallPlan.Configured c <- fromMaybe [] $ Graph.revClosure (Graph.fromDistinctList graph_with_repl_targets) bad, BuildInplaceOnly InMemory <- [elabBuildStyle c] - ] - - remove_repl_target :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage - remove_repl_target ecp - | ecp `elem` disabled_repl_targets = - ecp - { elabReplTarget = [] - , elabBuildStyle = BuildInplaceOnly OnDisk - } - | otherwise = ecp - - final_graph_with_repl_targets = map (mapConfiguredPackage remove_repl_target) graph_with_repl_targets - - -- Now find what the new roots are after we have disabled things which we can't build (and the things above that) - new_roots :: [UnitId] - new_roots = mapMaybe find_root (map (mapConfiguredPackage prune) final_graph_with_repl_targets) - - -- Then take the final closure from these new roots to remove these things - -- TODO: Can probably just remove them directly in remove_repl_target. - final_final_graph = fromMaybe [] $ Graph.closure (Graph.fromDistinctList final_graph_with_repl_targets) new_roots - is_root :: PrunedPackage -> Maybe UnitId is_root (PrunedPackage elab _) = if not $ @@ -3462,13 +3417,6 @@ our roots (graph closure), and then from this closed graph, we calculate the reverse closure, which gives us all components that depend on 'roots'. Thus, the result is a list of components that we need to load into the repl to uphold the closure property. - -Further to this, we then check that all the enabled components are using a new enough -version of Cabal which understands the repl option to write the arguments to a file. - -If there is a package using a custom Setup.hs which is linked against a too old version -of Cabal then we need to disable that as otherwise we will end up passing unknown -arguments to `./Setup`. -} -- | Given a set of already installed packages @availablePkgs@, diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.out b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.out new file mode 100644 index 0000000000000000000000000000000000000000..e92fa0c9fbaf838d9fc7e886d8ce0b7250665c03 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.out @@ -0,0 +1,9 @@ +# cabal v2-repl +Resolving dependencies... +Error: [Cabal-7107] +Could not resolve dependencies: +[__0] trying: pkg-b-0 (user goal) +[__1] next goal: pkg-b:setup.Cabal (dependency of pkg-b) +[__1] rejecting: pkg-b:setup.Cabal-<VERSION>/installed-<HASH> (constraint from --enable-multi-repl requires >=3.11) +[__1] fail (backjumping, conflict set: pkg-b, pkg-b:setup.Cabal) +After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: pkg-b (2), pkg-b:setup.Cabal (2) diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.project b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.project new file mode 100644 index 0000000000000000000000000000000000000000..91b0dbb40ffc9f978b36c67c7c2efcc0ff8d1600 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.project @@ -0,0 +1,3 @@ +packages: pkg-a/*.cabal +packages: pkg-b/*.cabal +packages: pkg-c/*.cabal diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.test.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.test.hs new file mode 100644 index 0000000000000000000000000000000000000000..2fcfe8e6533159d5219fbc2b68f976807dcb20a2 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.test.hs @@ -0,0 +1,11 @@ +import Test.Cabal.Prelude + +main = do + cabalTest $ do + -- MP: TODO: This should query Cabal library version + skipIfGhcVersion ">= 9.10" + -- Note: only the last package is interactive. + -- this test should load pkg-b too. + res <- fails $ cabalWithStdin "v2-repl" ["--enable-multi-repl","pkg-c", "pkg-a"] "Quu.quu" + + assertOutputContains "constraint from --enable-multi-repl requires >=3.11" res diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-a/Foo.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-a/Foo.hs new file mode 100644 index 0000000000000000000000000000000000000000..997ca89eecd49094853fabb4b65f4b5fa8ecb0c7 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-a/Foo.hs @@ -0,0 +1,5 @@ +module Foo where + +foo :: Int +foo = 42 + diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-a/pkg-a.cabal b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-a/pkg-a.cabal new file mode 100644 index 0000000000000000000000000000000000000000..e5241b6562189b9bc1e0d7ae1f4a77e3e977572b --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-a/pkg-a.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-a +version: 0 + +library + default-language: Haskell2010 + build-depends: base + exposed-modules: Foo diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-b/Bar.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-b/Bar.hs new file mode 100644 index 0000000000000000000000000000000000000000..958a85a057e0bd740fd44a7797c59df3d620e137 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-b/Bar.hs @@ -0,0 +1,6 @@ +module Bar where + +import Foo + +bar :: Int +bar = foo + foo diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-b/Setup.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-b/Setup.hs new file mode 100644 index 0000000000000000000000000000000000000000..ee48ce9a5f97d1f1cc9d4701f7c2221a8fe00d11 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-b/Setup.hs @@ -0,0 +1,5 @@ +module Setup where + +import Distribution.Simple + +main = defaultMain diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-b/pkg-b.cabal b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-b/pkg-b.cabal new file mode 100644 index 0000000000000000000000000000000000000000..2a10d9200185c543ce060b819d16bd5411f2d83b --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-b/pkg-b.cabal @@ -0,0 +1,12 @@ +cabal-version: 2.2 +name: pkg-b +version: 0 +build-type: Custom + +custom-setup + setup-depends: Cabal <= 3.11 + +library + default-language: Haskell2010 + build-depends: base, pkg-a + exposed-modules: Bar diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-c/Quu.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-c/Quu.hs new file mode 100644 index 0000000000000000000000000000000000000000..b684b61e21249e10cc3037a28ed55e29ff7d33b1 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-c/Quu.hs @@ -0,0 +1,6 @@ +module Quu where + +import Bar + +quu :: Int +quu = bar + bar diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-c/pkg-c.cabal b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-c/pkg-c.cabal new file mode 100644 index 0000000000000000000000000000000000000000..11363814d019356e653d467ee555c2c6057d780a --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/pkg-c/pkg-c.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-c +version: 0 + +library + default-language: Haskell2010 + build-depends: base, pkg-b + exposed-modules: Quu diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/cabal.out new file mode 100644 index 0000000000000000000000000000000000000000..d581aac783ea761e837866d07c12c572af96f0d4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/cabal.out @@ -0,0 +1,7 @@ +# cabal v2-repl +Resolving dependencies... +Build profile: -w ghc-<GHCVER> -O1 +In order, the following will be built: + - foo-0.1.0.0 (interactive) (first run) +Configuring foo-0.1.0.0... +Preprocessing executable 'foo' for foo-0.1.0.0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/cabal.project b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/cabal.project new file mode 100644 index 0000000000000000000000000000000000000000..4fb0af6804e1876aa472c64e7ce8c7e25d7191dc --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/cabal.project @@ -0,0 +1,2 @@ +packages: foo/ + diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/cabal.test.hs new file mode 100644 index 0000000000000000000000000000000000000000..20b9fc164aab18b3f4d43bb2af523477e40f6f05 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/cabal.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude + +main = do + cabalTest $ do + -- custom-setup stanza is not supported by Cabal's bundled with GHC's before 8.8 + skipUnlessGhcVersion ">= 8.8" + skipIfGhcVersion ">= 9.10" + res <- cabalWithStdin "v2-repl" ["foo"] "" + assertOutputContains "- foo-0.1.0.0 (interactive)" res diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/CHANGELOG.md b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/CHANGELOG.md new file mode 100644 index 0000000000000000000000000000000000000000..4d83316c82edbed08b835af841e302b845c4177c --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for foo + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/LICENSE b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/LICENSE new file mode 100644 index 0000000000000000000000000000000000000000..9f52c36c122b5e5cb2a7a278889b47ee2c8c388c --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2024, Teo Camarasu + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Teo Camarasu nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/Setup.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/Setup.hs new file mode 100644 index 0000000000000000000000000000000000000000..4cfb12a552771e26e321c3e1f818e2f42b01be80 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/Setup.hs @@ -0,0 +1,8 @@ +import Control.Monad +import Distribution.PackageDescription +import Distribution.Simple +import qualified Distribution.Simple as DS +import Distribution.Simple.Setup + +main :: IO () +main = DS.defaultMainWithHooks DS.simpleUserHooks diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/app/Main.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/app/Main.hs new file mode 100644 index 0000000000000000000000000000000000000000..65ae4a05d5db90794a0f769fd667e23df74f67e2 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/app/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/foo.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/foo.cabal new file mode 100644 index 0000000000000000000000000000000000000000..f655e2b0ee1026081306e8dbe7d0de9469fb23a7 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/CustomSetup/foo/foo.cabal @@ -0,0 +1,38 @@ +cabal-version: 3.0 +name: foo +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +author: Teo Camarasu +build-type: Custom +extra-doc-files: CHANGELOG.md + +custom-setup + setup-depends: + Cabal <= 3.11 + , base + +common warnings + ghc-options: -Wall + +executable foo + -- Import common warning flags. + import: warnings + + -- .hs or .lhs file containing the Main module. + main-is: Main.hs + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base + + -- Directories containing source files. + hs-source-dirs: app + + -- Base language which the package is written in. + default-language: Haskell2010