[Git][ghc/ghc][wip/t22884] 2 commits: Abstract cantFindError and turn Opt_BuildingCabal into a print-time option
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Apr 19 15:01:38 UTC 2023
Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC
Commits:
01c5ccbf by Matthew Pickering at 2023-04-19T16:01:11+01:00
Abstract cantFindError and turn Opt_BuildingCabal into a print-time option
* cantFindError is abstracted so that the parts which mention specific
things about ghc/ghci are parameters. The intention being that
GHC/GHCi can specify the right values to put here but otherwise
display the same error message.
* The BuildingCabalPackage argument from GenericMissing is removed and
turned into a print-time option. The reason for the error is not
dependent on whether `-fbuilding-cabal-package` is passed, so we don't
want to store that in the error message.
- - - - -
baea3f58 by Matthew Pickering at 2023-04-19T16:01:15+01:00
error messages: Don't display ghci specific hints for missing packages
I am unsure about whether the approach taken here is the best of most
maintainable solution. I put it up here for review and comment.
Fixes #22884
- - - - -
26 changed files:
- compiler/GHC/Driver/Config/Diagnostic.hs
- compiler/GHC/Iface/Errors.hs
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- ghc/GHCi/UI/Exception.hs
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr
- testsuite/tests/ghc-api/target-contents/TargetContents.stderr
- testsuite/tests/ghc-e/should_run/T2636.stderr
- testsuite/tests/module/mod1.stderr
- testsuite/tests/module/mod2.stderr
- + testsuite/tests/package/T22884.hs
- + testsuite/tests/package/T22884.stderr
- + testsuite/tests/package/T22884_interactive.script
- + testsuite/tests/package/T22884_interactive.stderr
- testsuite/tests/package/T4806.stderr
- testsuite/tests/package/T4806a.stderr
- testsuite/tests/package/all.T
- testsuite/tests/package/package01e.stderr
- testsuite/tests/package/package06e.stderr
- testsuite/tests/package/package07e.stderr
- testsuite/tests/package/package08e.stderr
- testsuite/tests/perf/compiler/parsing001.stderr
- testsuite/tests/plugins/T11244.stderr
- testsuite/tests/plugins/plugins03.stderr
- testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr
- testsuite/tests/typecheck/should_fail/tcfail082.stderr
Changes:
=====================================
compiler/GHC/Driver/Config/Diagnostic.hs
=====================================
@@ -18,7 +18,7 @@ import GHC.Prelude
import GHC.Utils.Outputable
import GHC.Utils.Error (DiagOpts (..))
-import GHC.Driver.Errors.Types (GhcMessage, GhcMessageOpts (..), PsMessage, DriverMessage, DriverMessageOpts (..))
+import GHC.Driver.Errors.Types (GhcMessage, GhcMessageOpts (..), PsMessage, DriverMessage, DriverMessageOpts (..), checkBuildingCabalPackage)
import GHC.Driver.Errors.Ppr ()
import GHC.Tc.Errors.Types
import GHC.HsToCore.Errors.Types
@@ -63,7 +63,8 @@ initDsMessageOpts _ = NoDiagnosticOpts
initIfaceMessageOpts :: DynFlags -> DiagnosticOpts IfaceMessage
initIfaceMessageOpts dflags =
- IfaceMessageOpts { ifaceShowTriedFiles = verbosity dflags >= 3 }
+ IfaceMessageOpts { ifaceShowTriedFiles = verbosity dflags >= 3
+ , ifaceBuildingCabalPackage = checkBuildingCabalPackage dflags }
initDriverMessageOpts :: DynFlags -> DiagnosticOpts DriverMessage
initDriverMessageOpts dflags = DriverMessageOpts (initPsMessageOpts dflags) (initIfaceMessageOpts dflags)
=====================================
compiler/GHC/Iface/Errors.hs
=====================================
@@ -13,7 +13,6 @@ import GHC.Platform.Ways
import GHC.Utils.Panic.Plain
import GHC.Driver.Session
import GHC.Driver.Env
-import GHC.Driver.Errors.Types
import GHC.Data.Maybe
import GHC.Prelude
import GHC.Unit
@@ -80,32 +79,29 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result
cannotFindModule :: HscEnv -> ModuleName -> FindResult -> MissingInterfaceError
cannotFindModule hsc_env = cannotFindModule'
- (hsc_dflags hsc_env)
(hsc_unit_env hsc_env)
(targetProfile (hsc_dflags hsc_env))
-cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult
+cannotFindModule' :: UnitEnv -> Profile -> ModuleName -> FindResult
-> MissingInterfaceError
-cannotFindModule' dflags unit_env profile mod res =
+cannotFindModule' unit_env profile mod res =
CantFindErr (ue_units unit_env) FindingModule $
- cantFindErr (checkBuildingCabalPackage dflags)
- unit_env
+ cantFindErr unit_env
profile
mod
res
cantFindErr
- :: BuildingCabalPackage -- ^ Using Cabal?
- -> UnitEnv
+ :: UnitEnv
-> Profile
-> ModuleName
-> FindResult
-> CantFindInstalled
-cantFindErr _ _ _ mod_name (FoundMultiple mods)
+cantFindErr _ _ mod_name (FoundMultiple mods)
= CantFindInstalled mod_name (MultiplePackages mods)
-cantFindErr using_cabal unit_env profile mod_name find_result
+cantFindErr unit_env profile mod_name find_result
= CantFindInstalled mod_name more_info
where
mhome_unit = ue_homeUnit unit_env
@@ -133,7 +129,7 @@ cantFindErr using_cabal unit_env profile mod_name find_result
-> NotAModule
| otherwise
- -> GenericMissing using_cabal
+ -> GenericMissing
(map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens)
mod_hiddens unusables files
_ -> panic "cantFindErr"
=====================================
compiler/GHC/Iface/Errors/Ppr.hs
=====================================
@@ -19,6 +19,11 @@ module GHC.Iface.Errors.Ppr
, missingInterfaceErrorReason
, missingInterfaceErrorDiagnostic
, readInterfaceErrorDiagnostic
+
+ , lookingForHerald
+ , cantFindErrorX
+ , mayShowLocations
+ , pkgHiddenHint
)
where
@@ -41,10 +46,12 @@ import GHC.Utils.Panic
import GHC.Iface.Errors.Types
data IfaceMessageOpts = IfaceMessageOpts { ifaceShowTriedFiles :: !Bool -- ^ Whether to show files we tried to look for or not when printing loader errors
+ , ifaceBuildingCabalPackage :: !BuildingCabalPackage
}
defaultIfaceMessageOpts :: IfaceMessageOpts
-defaultIfaceMessageOpts = IfaceMessageOpts { ifaceShowTriedFiles = False }
+defaultIfaceMessageOpts = IfaceMessageOpts { ifaceShowTriedFiles = False
+ , ifaceBuildingCabalPackage = NoBuildingCabalPackage }
instance Diagnostic IfaceMessage where
@@ -116,7 +123,7 @@ isAmbiguousInstalledReason _ = AoM_Missing
isLoadOrFindReason :: CantFindInstalledReason -> FindOrLoad
isLoadOrFindReason NotAModule {} = Find
-isLoadOrFindReason (GenericMissing _ a b c _) | null a && null b && null c = Find
+isLoadOrFindReason (GenericMissing a b c _) | null a && null b && null c = Find
isLoadOrFindReason (ModuleSuggestion {}) = Find
isLoadOrFindReason _ = Load
@@ -124,8 +131,38 @@ data FindOrLoad = Find | Load
data AmbiguousOrMissing = AoM_Ambiguous | AoM_Missing
-cantFindError :: IfaceMessageOpts -> FindingModuleOrInterface -> CantFindInstalled -> SDoc
-cantFindError opts mod_or_interface (CantFindInstalled mod_name cfir) =
+cantFindError :: IfaceMessageOpts
+ -> FindingModuleOrInterface
+ -> CantFindInstalled
+ -> SDoc
+cantFindError opts = cantFindErrorX (pkgHiddenHint (const empty) (ifaceBuildingCabalPackage opts)) (mayShowLocations "-v" (ifaceShowTriedFiles opts))
+ where
+
+pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage
+ -> Maybe UnitInfo -> SDoc
+pkgHiddenHint hint using_cabal (Just pkg)
+ | using_cabal == YesBuildingCabalPackage
+ = text "Perhaps you need to add" <+>
+ quotes (ppr (unitPackageName pkg)) <+>
+ text "to the build-depends in your .cabal file."
+
+ | otherwise
+ = hint pkg
+pkgHiddenHint _ _ Nothing = empty
+
+mayShowLocations :: String -> Bool -> [FilePath] -> SDoc
+mayShowLocations option verbose files
+ | null files = empty
+ | not verbose =
+ text "Use" <+> text option <+>
+ text "to see a list of the files searched for."
+ | otherwise =
+ hang (text "Locations searched:") 2 $ vcat (map text files)
+
+-- | General version of cantFindError which has some holes which allow GHC/GHCi to display slightly different
+-- error messages.
+cantFindErrorX :: (Maybe UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc
+cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstalled mod_name cfir) =
let ambig = isAmbiguousInstalledReason cfir
find_or_load = isLoadOrFindReason cfir
ppr_what = prettyCantFindWhat find_or_load mod_or_interface ambig
@@ -153,11 +190,11 @@ cantFindError opts mod_or_interface (CantFindInstalled mod_name cfir) =
text "There are files missing in the " <> quotes (ppr pkg) <+>
text "package," $$
text "try running 'ghc-pkg check'." $$
- mayShowLocations verbose files
+ mayShowLocations files
MissingPackageWayFiles build pkg files ->
text "Perhaps you haven't installed the " <> text build <+>
text "libraries for package " <> quotes (ppr pkg) <> char '?' $$
- mayShowLocations verbose files
+ mayShowLocations files
ModuleSuggestion ms fps ->
let pp_suggestions :: [ModuleSuggestion] -> SDoc
@@ -199,7 +236,7 @@ cantFindError opts mod_or_interface (CantFindInstalled mod_name cfir) =
<+> ppr (mkUnit pkg))
| otherwise = empty
- in pp_suggestions ms $$ mayShowLocations verbose fps
+ in pp_suggestions ms $$ mayShowLocations fps
NotAModule -> text "It is not a module in the current program, or in any known package."
CouldntFindInFiles fps -> vcat (map text fps)
MultiplePackages mods
@@ -213,14 +250,12 @@ cantFindError opts mod_or_interface (CantFindInstalled mod_name cfir) =
unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
= Just (moduleUnit m : xs)
unambiguousPackage _ _ = Nothing
- GenericMissing using_cabal pkg_hiddens mod_hiddens unusables files ->
- vcat (map (pkg_hidden using_cabal) pkg_hiddens) $$
+ GenericMissing pkg_hiddens mod_hiddens unusables files ->
+ vcat (map pkg_hidden pkg_hiddens) $$
vcat (map mod_hidden mod_hiddens) $$
vcat (map unusable unusables) $$
- mayShowLocations verbose files
+ mayShowLocations files
where
- verbose = ifaceShowTriedFiles opts
-
pprMod (m, o) = text "it is bound as" <+> ppr m <+>
text "by" <+> pprOrigin m o
pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
@@ -233,26 +268,14 @@ cantFindError opts mod_or_interface (CantFindInstalled mod_name cfir) =
.ppr.mkUnit) res ++
if f then [text "a package flag"] else []
)
- pkg_hidden :: BuildingCabalPackage -> (Unit, Maybe UnitInfo) -> SDoc
- pkg_hidden using_cabal (uid, uif) =
+ pkg_hidden :: (Unit, Maybe UnitInfo) -> SDoc
+ pkg_hidden (uid, uif) =
text "It is a member of the hidden package"
<+> quotes (ppr uid)
--FIXME: we don't really want to show the unit id here we should
-- show the source package id or installed package id if it's ambiguous
- <> dot $$ pkg_hidden_hint using_cabal uif
-
- pkg_hidden_hint using_cabal (Just pkg)
- | using_cabal == YesBuildingCabalPackage
- = text "Perhaps you need to add" <+>
- quotes (ppr (unitPackageName pkg)) <+>
- text "to the build-depends in your .cabal file."
- -- MP: This is ghci specific, remove
- | otherwise
- = text "You can run" <+>
- quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
- text "to expose it." $$
- text "(Note: this unloads all the modules in the current scope.)"
- pkg_hidden_hint _ Nothing = empty
+ <> dot $$ pkg_hidden_hint uif
+
mod_hidden pkg =
text "it is a hidden module in the package" <+> quotes (ppr pkg)
@@ -262,31 +285,23 @@ cantFindError opts mod_or_interface (CantFindInstalled mod_name cfir) =
<+> quotes (ppr pkg)
$$ pprReason (text "which is") reason
-mayShowLocations :: Bool -> [FilePath] -> SDoc
-mayShowLocations verbose files
- | null files = empty
- | not verbose =
- text "Use -v (or `:set -v` in ghci) " <>
- text "to see a list of the files searched for."
- | otherwise =
- hang (text "Locations searched:") 2 $ vcat (map text files)
interfaceErrorDiagnostic :: IfaceMessageOpts -> IfaceMessage -> SDoc
interfaceErrorDiagnostic opts = \ case
Can'tFindNameInInterface name relevant_tyThings ->
missingDeclInInterface name relevant_tyThings
Can'tFindInterface err looking_for ->
+ hangNotEmpty (lookingForHerald looking_for) 2 (missingInterfaceErrorDiagnostic opts err)
+
+lookingForHerald :: InterfaceLookingFor -> SDoc
+lookingForHerald looking_for =
case looking_for of
- LookingForName {} ->
- missingInterfaceErrorDiagnostic opts err
- LookingForModule {} ->
- missingInterfaceErrorDiagnostic opts err
+ LookingForName {} -> empty
+ LookingForModule {} -> empty
LookingForHiBoot mod ->
- hang (text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon)
- 2 (missingInterfaceErrorDiagnostic opts err)
+ text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon
LookingForSig sig ->
- hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon)
- 2 (missingInterfaceErrorDiagnostic opts err)
+ text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon
readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc
readInterfaceErrorDiagnostic = \ case
=====================================
compiler/GHC/Iface/Errors/Types.hs
=====================================
@@ -70,7 +70,7 @@ data CantFindInstalledReason
| ModuleSuggestion [ModuleSuggestion] [FilePath]
| NotAModule
| CouldntFindInFiles [FilePath]
- | GenericMissing BuildingCabalPackage
+ | GenericMissing
[(Unit, Maybe UnitInfo)] [Unit]
[(Unit, UnusableUnitReason)] [FilePath]
| MultiplePackages [(Module, ModuleOrigin)]
=====================================
ghc/GHCi/UI/Exception.hs
=====================================
@@ -10,8 +10,14 @@ import GHC.Driver.Session
import GHC.Types.SourceError
import GHC.Driver.Errors.Types
import GHC.Types.Error
+import GHC.Iface.Errors.Types
+import GHC.Tc.Errors.Types
+import GHC.Tc.Errors.Ppr
+import GHC.Iface.Errors.Ppr
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Errors
+import GHC.Utils.Outputable
+import GHC.Unit.State
-- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting
-- for some error messages.
@@ -24,14 +30,14 @@ printGhciException err = do
liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err))
-newtype GHCiMessage = GHCiMessage { getGhciMessage :: GhcMessage }
+newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage }
instance Diagnostic GHCiMessage where
type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage
defaultDiagnosticOpts = defaultDiagnosticOpts @GhcMessage
- diagnosticMessage opts (GHCiMessage msg) = diagnosticMessage opts msg
+ diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg
diagnosticReason (GHCiMessage msg) = diagnosticReason msg
@@ -39,4 +45,38 @@ instance Diagnostic GHCiMessage where
diagnosticCode (GHCiMessage msg) = diagnosticCode msg
+-- Modifications to error messages which we want to display in GHCi
+ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc
+ghciDiagnosticMessage ghc_opts msg =
+ case msg of
+ GhcTcRnMessage (TcRnInterfaceError err) ->
+ case ghciInterfaceError err of
+ Just sdoc -> mkSimpleDecorated sdoc
+ Nothing -> diagnosticMessage ghc_opts msg
+ GhcDriverMessage (DriverInterfaceError err) ->
+ case ghciInterfaceError err of
+ Just sdoc -> mkSimpleDecorated sdoc
+ Nothing -> diagnosticMessage ghc_opts msg
+ _ -> diagnosticMessage ghc_opts msg
+ where
+ opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts)
+ ghciInterfaceError (Can'tFindInterface err looking_for) =
+ hangNotEmpty (lookingForHerald looking_for) 2 <$> ghciMissingInterfaceErrorDiagnostic err
+ ghciInterfaceError _ = Nothing
+
+ ghciMissingInterfaceErrorDiagnostic reason =
+ case reason of
+ CantFindErr us module_or_interface cfi -> Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi)
+ _ -> Nothing
+ where
+
+ may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts)
+
+ pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts)
+ where
+ hidden_msg pkg =
+ text "You can run" <+>
+ quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
+ text "to expose it." $$
+ text "(Note: this unloads all the modules in the current scope.)"
=====================================
testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr
=====================================
@@ -2,4 +2,4 @@
module-visibility-import/MV.hs:5:1: error: [GHC-87110]
Could not load module ‘MV2’.
it is a hidden module in the package ‘mv’
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/ghc-api/target-contents/TargetContents.stderr
=====================================
@@ -18,7 +18,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z
A.hs:3:1: error: [GHC-87110]
Could not find module ‘B’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
== Dep_DM_AB
== Dep_Error_DM_AB
@@ -27,7 +27,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z
A.hs:3:1: error: [GHC-87110]
Could not find module ‘B’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
== Dep_MD_AB
== Dep_Error_MD_AB
=====================================
testsuite/tests/ghc-e/should_run/T2636.stderr
=====================================
@@ -1,4 +1,4 @@
T2636.hs:1:1: error: [GHC-87110]
Could not find module ‘MissingModule’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/module/mod1.stderr
=====================================
@@ -1,4 +1,4 @@
mod1.hs:3:1: error: [GHC-87110]
Could not find module ‘N’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/module/mod2.stderr
=====================================
@@ -1,4 +1,4 @@
mod2.hs:3:1: error: [GHC-87110]
Could not find module ‘N’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/T22884.hs
=====================================
@@ -0,0 +1,3 @@
+module T22884 where
+
+import Data.Text
=====================================
testsuite/tests/package/T22884.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T22884.hs:3:1: error: [GHC-87110]
+ Could not load module ‘Data.Text’.
+ It is a member of the hidden package ‘text-2.0.2’.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/T22884_interactive.script
=====================================
@@ -0,0 +1,3 @@
+:set -hide-all-packages
+
+import Data.Text
=====================================
testsuite/tests/package/T22884_interactive.stderr
=====================================
@@ -0,0 +1,6 @@
+
+<no location info>: error: [GHC-87110]
+ Could not load module ‘Data.Text’.
+ It is a member of the hidden package ‘text-2.0.2’.
+ You can run ‘:set -package text’ to expose it.
+ (Note: this unloads all the modules in the current scope.)
=====================================
testsuite/tests/package/T4806.stderr
=====================================
@@ -3,4 +3,4 @@ T4806.hs:1:1: error: [GHC-87110]
Could not load module ‘Data.Map’.
It is a member of the package ‘containers-0.6.7’
which is ignored due to an -ignore-package flag
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/T4806a.stderr
=====================================
@@ -4,4 +4,4 @@ T4806a.hs:1:1: error: [GHC-87110]
It is a member of the package ‘containers-0.6.7’
which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies:
deepseq-1.4.8.1 template-haskell-2.20.0.0
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/all.T
=====================================
@@ -20,3 +20,5 @@ test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC
test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers'])
test('T4806a', normalise_version('deepseq', 'containers'), compile_fail, ['-ignore-package deepseq'])
+test('T22884', normalise_version('text'), compile_fail, ['-hide-package text'])
+test('T22884_interactive', normalise_version('text'), ghci_script, ['T22884_interactive.script'])
=====================================
testsuite/tests/package/package01e.stderr
=====================================
@@ -2,13 +2,9 @@
package01e.hs:2:1: error: [GHC-87110]
Could not load module ‘Data.Map’.
It is a member of the hidden package ‘containers-0.6.7’.
- You can run ‘:set -package containers’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package01e.hs:3:1: error: [GHC-87110]
Could not load module ‘Data.IntMap’.
It is a member of the hidden package ‘containers-0.6.7’.
- You can run ‘:set -package containers’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/package06e.stderr
=====================================
@@ -2,13 +2,9 @@
package06e.hs:2:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Type’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package06e.hs:3:1: error: [GHC-87110]
Could not load module ‘GHC.Types.Unique.FM’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/package07e.stderr
=====================================
@@ -5,25 +5,19 @@ package07e.hs:2:1: error: [GHC-61948]
GHC.Hs.Type (needs flag -package-id ghc-9.7)
GHC.Tc.Types (needs flag -package-id ghc-9.7)
GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package07e.hs:3:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Type’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package07e.hs:4:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Utils’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package07e.hs:5:1: error: [GHC-87110]
Could not load module ‘GHC.Types.Unique.FM’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/package08e.stderr
=====================================
@@ -5,25 +5,19 @@ package08e.hs:2:1: error: [GHC-61948]
GHC.Hs.Type (needs flag -package-id ghc-9.7)
GHC.Tc.Types (needs flag -package-id ghc-9.7)
GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package08e.hs:3:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Type’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package08e.hs:4:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Utils’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package08e.hs:5:1: error: [GHC-87110]
Could not load module ‘GHC.Types.Unique.FM’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/perf/compiler/parsing001.stderr
=====================================
@@ -1,4 +1,4 @@
parsing001.hs:3:1: error: [GHC-87110]
Could not find module ‘Wibble’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/plugins/T11244.stderr
=====================================
@@ -1,5 +1,3 @@
<command line>: Could not load module ‘RuleDefiningPlugin’.
It is a member of the hidden package ‘rule-defining-plugin-0.1’.
-You can run ‘:set -package rule-defining-plugin’ to expose it.
-(Note: this unloads all the modules in the current scope.)
-Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+Use -v to see a list of the files searched for.
=====================================
testsuite/tests/plugins/plugins03.stderr
=====================================
@@ -1,2 +1,2 @@
<command line>: Could not find module ‘Simple.NonExistentPlugin’.
-Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+Use -v to see a list of the files searched for.
=====================================
testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr
=====================================
@@ -4,4 +4,4 @@ SafeLang07.hs:2:14: warning:
SafeLang07.hs:15:1: error: [GHC-87110]
Could not find module ‘SafeLang07_A’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/typecheck/should_fail/tcfail082.stderr
=====================================
@@ -1,12 +1,12 @@
tcfail082.hs:2:1: error: [GHC-87110]
Could not find module ‘Data82’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
tcfail082.hs:3:1: error: [GHC-87110]
Could not find module ‘Inst82_1’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
tcfail082.hs:4:1: error: [GHC-87110]
Could not find module ‘Inst82_2’.
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd2b0ddc3cbae767b09302781aa7fe52815e4b4...baea3f5869eb108e04b94cc3d3e958d243fa6026
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd2b0ddc3cbae767b09302781aa7fe52815e4b4...baea3f5869eb108e04b94cc3d3e958d243fa6026
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230419/28d963ce/attachment-0001.html>
More information about the ghc-commits
mailing list