diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index c7774eb0cedb6960b0d917d8d869a3a31609f2c9..4922dfb851cf59b1759a1447cd867c0d6ec1161b 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -174,6 +174,7 @@ module GHC.Driver.Session ( parseDynamicFlagsCmdLine, parseDynamicFilePragma, parseDynamicFlagsFull, + flagSuggestions, -- ** Available DynFlags allNonDeprecatedFlags, @@ -272,7 +273,7 @@ import Data.Functor.Identity import Data.Ord import Data.Char -import Data.List (intercalate, sortBy) +import Data.List (intercalate, sortBy, partition) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set @@ -886,6 +887,20 @@ safeFlagCheck cmdl dflags = -- Force this to avoid retaining reference to old DynFlags value !safeFlags = all (\(_,_,t,_) -> not $ t dflags) unsafeFlagsForInfer +-- | Produce a list of suggestions for a user provided flag that is invalid. +flagSuggestions + :: [String] -- valid flags to match against + -> String + -> [String] +flagSuggestions flags userInput + -- fixes #11789 + -- If the flag contains '=', + -- this uses both the whole and the left side of '=' for comparing. + | elem '=' userInput = + let (flagsWithEq, flagsWithoutEq) = partition (elem '=') flags + fName = takeWhile (/= '=') userInput + in (fuzzyMatch userInput flagsWithEq) ++ (fuzzyMatch fName flagsWithoutEq) + | otherwise = fuzzyMatch userInput flags {- ********************************************************************** %* * diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index ccd33e65683e045e890e5a6fe3555d0be8661387..f412467c70d6fcb664f7261739ebb3b021a5f9de 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -3144,10 +3144,7 @@ newDynFlags interactive_only minus_opts = do (idflags1, leftovers, warns) <- DynFlags.parseDynamicFlagsCmdLine idflags0 lopts liftIO $ printOrThrowDiagnostics logger (initPrintConfig idflags1) (initDiagOpts idflags1) (GhcDriverMessage <$> warns) - when (not $ null leftovers) - (throwGhcException . CmdLineError - $ "Some flags have not been recognized: " - ++ (concat . intersperse ", " $ map unLoc leftovers)) + when (not $ null leftovers) (unknownFlagsErr $ map unLoc leftovers) when (interactive_only && packageFlagsChanged idflags1 idflags0) $ do liftIO $ hPutStrLn stderr "cannot set package flags with :seti; use :set" @@ -3197,6 +3194,15 @@ newDynFlags interactive_only minus_opts = do return () +unknownFlagsErr :: [String] -> a +unknownFlagsErr fs = throwGhcException $ CmdLineError $ concatMap oneError fs + where + oneError f = + "unrecognised flag: " ++ f ++ "\n" ++ + (case flagSuggestions ghciFlags f of + [] -> "" + suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) + ghciFlags = nubSort $ flagsForCompletion True unsetOptions :: GhciMonad m => String -> m () unsetOptions str diff --git a/ghc/Main.hs b/ghc/Main.hs index 5a65b36306cca33d3f44b4ac5ec2d44f1fcc7e96..22ddd49ca585e86a68c56b4e8f2c2e69f8ec69e6 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -1138,15 +1138,6 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs where oneError f = "unrecognised flag: " ++ f ++ "\n" ++ - (case match f (nubSort allNonDeprecatedFlags) of + (case flagSuggestions (nubSort allNonDeprecatedFlags) f of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) - -- fixes #11789 - -- If the flag contains '=', - -- this uses both the whole and the left side of '=' for comparing. - match f allFlags - | elem '=' f = - let (flagsWithEq, flagsWithoutEq) = partition (elem '=') allFlags - fName = takeWhile (/= '=') f - in (fuzzyMatch f flagsWithEq) ++ (fuzzyMatch fName flagsWithoutEq) - | otherwise = fuzzyMatch f allFlags diff --git a/testsuite/tests/ghc-e/should_fail/Makefile b/testsuite/tests/ghc-e/should_fail/Makefile index 627d85fe43617a8073557d4913efe9fdbdf95bb1..2f69710424407cccdc21d0305fc29b34049fe41d 100644 --- a/testsuite/tests/ghc-e/should_fail/Makefile +++ b/testsuite/tests/ghc-e/should_fail/Makefile @@ -76,3 +76,6 @@ T18441fail17: T18441fail18: -'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e ":main" || echo $$? >&2 + +T23663: + -'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e ":set -XCUSKS" || echo $$? >&2 # misspelled flag diff --git a/testsuite/tests/ghc-e/should_fail/T18441fail2.stderr b/testsuite/tests/ghc-e/should_fail/T18441fail2.stderr index 849747f5eb4620cbe7f616628e02eba30fa5164b..2f482aa5be1f3b7c9c6e7ff4a0e2376980cc69a0 100644 --- a/testsuite/tests/ghc-e/should_fail/T18441fail2.stderr +++ b/testsuite/tests/ghc-e/should_fail/T18441fail2.stderr @@ -1,2 +1,3 @@ -<interactive>: Some flags have not been recognized: -Xabcde +<interactive>: unrecognised flag: -Xabcde + 1 diff --git a/testsuite/tests/ghc-e/should_fail/T23663.stderr b/testsuite/tests/ghc-e/should_fail/T23663.stderr new file mode 100644 index 0000000000000000000000000000000000000000..6180206af996a11e3daa22eec5e2b43252c4d594 --- /dev/null +++ b/testsuite/tests/ghc-e/should_fail/T23663.stderr @@ -0,0 +1,5 @@ +<interactive>: unrecognised flag: -XCUSKS +did you mean one of: + -XCUSKs + +1 diff --git a/testsuite/tests/ghc-e/should_fail/all.T b/testsuite/tests/ghc-e/should_fail/all.T index 7196bbe96919c22b4e95e8c2908a5cf6a1713fc9..f4840f9685783902656ea9e056899aecddbb3b4d 100644 --- a/testsuite/tests/ghc-e/should_fail/all.T +++ b/testsuite/tests/ghc-e/should_fail/all.T @@ -54,3 +54,5 @@ test('T18441fail17', req_interp, makefile_test, ['T18441fail17']) test('T18441fail18', req_interp, makefile_test, ['T18441fail18']) test('T18441fail19', [ignore_stderr, exit_code(1)], run_command, ['{compiler} -e ":cd abcd"']) + +test('T23663', req_interp, makefile_test, ['T23663']) diff --git a/testsuite/tests/safeHaskell/ghci/p12.stderr b/testsuite/tests/safeHaskell/ghci/p12.stderr index a552be6d6c53f634f7465ca91add4592c7cf11ce..5534c7df8635980beec8012b1149241cee5a26cd 100644 --- a/testsuite/tests/safeHaskell/ghci/p12.stderr +++ b/testsuite/tests/safeHaskell/ghci/p12.stderr @@ -1,6 +1,12 @@ -Some flags have not been recognized: -XNoSafe -Some flags have not been recognized: -fno-package-trust +unrecognised flag: -XNoSafe +did you mean one of: + -XSafe + +unrecognised flag: -fno-package-trust +did you mean one of: + -fpackage-trust + <no location info>: error: [GHC-75165] Data.ByteString: Can't be safely imported! - The package (bytestring-0.11.3.0) the module resides in isn't trusted. + The package (bytestring-0.11.4.0) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/ghci/p5.stderr b/testsuite/tests/safeHaskell/ghci/p5.stderr index 6579b9f765c5867ad234a0de27e08f8288eb4113..ebf2c0334a51fb5a0630aa0802f06ec9f0cf2a25 100644 --- a/testsuite/tests/safeHaskell/ghci/p5.stderr +++ b/testsuite/tests/safeHaskell/ghci/p5.stderr @@ -1,7 +1,16 @@ -Some flags have not been recognized: -XNoSafe +unrecognised flag: -XNoSafe +did you mean one of: + -XSafe + <no location info>: Incompatible Safe Haskell flags! (Safe, Trustworthy) Usage: For basic information, try the `--help' option. -Some flags have not been recognized: -XNoTrustworthy +unrecognised flag: -XNoTrustworthy +did you mean one of: + -XTrustworthy + <no location info>: Incompatible Safe Haskell flags! (Safe, Unsafe) Usage: For basic information, try the `--help' option. -Some flags have not been recognized: -XNoUnsafe +unrecognised flag: -XNoUnsafe +did you mean one of: + -XUnsafe +