From 2ae2694bb7d83b7ed8e51a1f46546a8d5853f0b0 Mon Sep 17 00:00:00 2001
From: BasLaa <baslaarakker@gmail.com>
Date: Tue, 31 Jan 2023 15:10:53 +0100
Subject: [PATCH] Add warning +RTS flag
---
.../src/Distribution/Client/CmdRun.hs | 22 +++++++++++++++++--
.../NewBuild/CmdRun/WarningRTS/cabal.out | 12 ++++++++++
.../NewBuild/CmdRun/WarningRTS/cabal.test.hs | 7 +++---
3 files changed, 35 insertions(+), 6 deletions(-)
create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/WarningRTS/cabal.out
diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs
index 64241fd8bb..e376802345 100644
--- a/cabal-install/src/Distribution/Client/CmdRun.hs
+++ b/cabal-install/src/Distribution/Client/CmdRun.hs
@@ -47,7 +47,7 @@ import Distribution.Types.ComponentName
import Distribution.Verbosity
( normal, silent )
import Distribution.Simple.Utils
- ( wrapText, die', info, notice, safeHead )
+ ( wrapText, die', info, notice, safeHead, warn )
import Distribution.Client.ProjectPlanning
( ElaboratedConfiguredPackage(..)
, ElaboratedInstallPlan, binDirectoryFor )
@@ -65,8 +65,12 @@ import Distribution.Types.UnitId
import Distribution.Client.ScriptUtils
( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) )
-import Data.List (group)
+import Data.List (elemIndex, group)
import qualified Data.Set as Set
+
+import GHC.Environment
+ ( getFullArgs )
+
import System.Directory
( doesFileExist )
import System.FilePath
@@ -138,6 +142,13 @@ runAction flags@NixStyleFlags {..} targetAndArgs globalFlags
"The run command does not support '--only-dependencies'. "
++ "You may wish to use 'build --only-dependencies' and then "
++ "use 'run'."
+
+ fullArgs <- getFullArgs
+ when (occursOnlyOrBefore fullArgs "+RTS" "--") $
+ warn verbosity $
+ "Your RTS options are applied to cabal, not the executable. "
+ ++ "Use 'cabal run -- +RTS -N' to pass the RTS options "
+ ++ "to your executable."
-- Interpret the targets on the command line as build targets
-- (as opposed to say repl or haddock targets).
@@ -462,3 +473,10 @@ renderRunProblem (TargetProblemNoExes targetSelector) =
++ " because "
++ plural (targetSelectorPluralPkgs targetSelector) "it does" "they do"
++ " not contain any executables."
+
+-- True if x occurs before y
+occursOnlyOrBefore :: (Eq a) => [a] -> a -> a -> Bool
+occursOnlyOrBefore xs x y = case (elemIndex x xs, elemIndex y xs) of
+ (Just i, Just j) -> i < j
+ (Just _, _) -> True
+ _ -> False
diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/WarningRTS/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/WarningRTS/cabal.out
new file mode 100644
index 0000000000..bca7e23dd8
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/WarningRTS/cabal.out
@@ -0,0 +1,12 @@
+# cabal run
+Resolving dependencies...
+Warning: Your RTS options are applied to cabal, not the executable. Use 'cabal run -- +RTS -N' to pass the RTS options to your executable.
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - WarningRTS-1.0 (exe:foo) (first run)
+Configuring executable 'foo' for WarningRTS-1.0..
+Preprocessing executable 'foo' for WarningRTS-1.0..
+Building executable 'foo' for WarningRTS-1.0..
+# cabal run
+Warning: Your RTS options are applied to cabal, not the executable. Use 'cabal run -- +RTS -N' to pass the RTS options to your executable.
+# cabal run
diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/WarningRTS/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/WarningRTS/cabal.test.hs
index 70bc4ac3a5..99b9f2008a 100644
--- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/WarningRTS/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/WarningRTS/cabal.test.hs
@@ -1,12 +1,11 @@
import Test.Cabal.Prelude
main = cabalTest $ do
- -- your test code here
res <- cabal' "run" ["foo", "+RTS"]
- assertOutputContains "Warning" res
+ assertOutputContains "Warning: Your RTS options" res
res <- cabal' "run" ["foo", "+RTS", "--"]
- assertOutputContains "Warning" res
+ assertOutputContains "Warning: Your RTS options" res
res <- cabal' "run" ["foo", "--", "+RTS"]
- assertOutputDoesNotContain "Warning" res
+ assertOutputDoesNotContain "Warning: Your RTS options" res
--
GitLab