[Git][ghc/ghc][wip/splice-imports-2024] 5 commits: testsuite: T25090 test, pass TEST_HC_OPTS when calling GHC
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Thu Oct 24 12:58:08 UTC 2024
Matthew Pickering pushed to branch wip/splice-imports-2024 at Glasgow Haskell Compiler / GHC
Commits:
caf3ae71 by Matthew Pickering at 2024-10-24T10:35:27+01:00
testsuite: T25090 test, pass TEST_HC_OPTS when calling GHC
These options should be passed to that the commands don't print out
debug output.
- - - - -
4c8dd8e8 by Matthew Pickering at 2024-10-24T10:40:28+01:00
wip
- - - - -
22f25643 by Matthew Pickering at 2024-10-24T10:40:49+01:00
testsuite: Pass TEST_HC_OPTS to T24634
- - - - -
e3a49e33 by Matthew Pickering at 2024-10-24T10:42:36+01:00
testsuite: Pass TEST_HC_OPTS to T25166
- - - - -
3a654716 by Matthew Pickering at 2024-10-24T13:57:36+01:00
wip
- - - - -
26 changed files:
- compiler/GHC/Core/InstEnv.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Unit/Module/Graph.hs
- testsuite/tests/bytecode/T24634/Makefile
- testsuite/tests/bytecode/T25090/Makefile
- testsuite/tests/codeGen/should_compile/Makefile
- testsuite/tests/splice-imports/SI03.stderr
- testsuite/tests/splice-imports/SI05.stderr
- testsuite/tests/splice-imports/SI07.stderr
- testsuite/tests/splice-imports/SI08.hs
- testsuite/tests/splice-imports/SI08.stderr
- + testsuite/tests/splice-imports/SI11.stderr
- + testsuite/tests/splice-imports/SI12.stderr
- + testsuite/tests/splice-imports/SI14.hs
- + testsuite/tests/splice-imports/SI14.stderr
- + testsuite/tests/splice-imports/SI15.hs
- testsuite/tests/splice-imports/all.T
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/Core/InstEnv.hs
=====================================
@@ -1205,7 +1205,7 @@ lookupInstEnv check_overlap_safe
, ie_visible = vis_mods })
cls
tys
- = pprTrace "lookup" (ppr home_ie) $ (final_matches, final_unifs, unsafe_overlapped)
+ = (final_matches, final_unifs, unsafe_overlapped)
where
(home_matches, home_unifs) = lookupInstEnv' home_ie vis_mods cls tys
(pkg_matches, pkg_unifs) = lookupInstEnv' pkg_ie vis_mods cls tys
=====================================
compiler/GHC/Driver/Env.hs
=====================================
@@ -239,13 +239,13 @@ hptAllInstances hsc_env
hptInstancesBelow :: HscEnv -> UnitId -> ModuleStage -> ModuleNameWithIsBoot -> (NameEnv (Set.Set ThLevel), InstEnv, [FamInst])
hptInstancesBelow hsc_env uid lvl mnwib =
let
- mk_bind_env clvl ie = mkNameEnv $ flip zip (repeat (Set.singleton clvl)) $ map is_dfun_name (instEnvElts ie)
+ mk_bind_env clvl ie = mkNameEnv $ flip zip (repeat (Set.singleton (moduleStageToThLevel clvl))) $ map is_dfun_name (instEnvElts ie)
mn = gwib_mod mnwib
(bind_env, insts, famInsts) =
unzip3 $ hptSomeThingsBelowUs (\mlvl mod_info ->
let details = hm_details mod_info
-- Don't include instances for the current module
- in pprTrace "lvl" (ppr mlvl) $ if moduleName (mi_module (hm_iface mod_info)) == mn
+ in if moduleName (mi_module (hm_iface mod_info)) == mn
then []
else [(mk_bind_env mlvl (md_insts details), md_insts details, md_fam_insts details)])
True -- Include -hi-boot
@@ -255,7 +255,7 @@ hptInstancesBelow hsc_env uid lvl mnwib =
mnwib
-- Horrible horrible
hack = mkInstEnv (nubBy (\c1 c2 -> instanceDFunId c1 == instanceDFunId c2) (concatMap instEnvElts insts))
- in (foldl' (plusNameEnv_C Set.union) emptyNameEnv bind_env, hack, concat famInsts)
+ in ((foldl' (plusNameEnv_C Set.union) emptyNameEnv bind_env), hack, concat famInsts)
-- | Get rules from modules "below" this one (in the dependency sense)
hptRules :: HscEnv -> UnitId -> ModuleStage -> ModuleNameWithIsBoot -> [CoreRule]
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -667,8 +667,8 @@ createBuildPlan mod_graph maybe_top_mod =
in
- assertPpr (sum (map countMods build_plan) == length (collapseModuleGraph $ mgModSummaries' mod_graph))
- (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (collapseModuleGraph $ mgModSummaries' mod_graph )))])
+ assertPpr (sum (map countMods build_plan) == length (collapseModuleGraphNodes $ mgModSummaries' mod_graph))
+ (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (collapseModuleGraphNodes $ mgModSummaries' mod_graph )))])
build_plan
mkWorkerLimit :: DynFlags -> IO WorkerLimit
@@ -1478,7 +1478,7 @@ topSortModuleGraph
topSortModuleGraph drop_hs_boot_nodes module_graph mb_root_mod =
-- stronglyConnCompG flips the original order, so if we reverse
-- the summaries we get a stable topological sort.
- topSortModules drop_hs_boot_nodes (reverse $ collapseModuleGraph $ mgModSummaries' module_graph) mb_root_mod
+ topSortModules drop_hs_boot_nodes (reverse $ collapseModuleGraphNodes $ mgModSummaries' module_graph) mb_root_mod
topSortModules :: Bool -> [ModuleGraphNode] -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
topSortModules drop_hs_boot_nodes summaries mb_root_mod
@@ -1637,8 +1637,8 @@ downsweep_imports hsc_env old_summaries excl_mods allow_dup_roots (root_errs, ro
[(ms_unitid ms, offsetStage lvl st, b, c) | (st, b, c) <- msDeps ms ]
offsetStage lvl NormalStage = lvl
- offsetStage lvl QuoteStage = lvl + 1
- offsetStage lvl SpliceStage = lvl - 1
+ offsetStage lvl QuoteStage = incModuleStage lvl
+ offsetStage lvl SpliceStage = decModuleStage lvl
logger = hsc_logger hsc_env
=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -123,6 +123,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
else do
(pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods
return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs))
+ pprTraceM "ld" (ppr (all_home_mods, mods_s, pkgs_s))
let
-- 2. Exclude ones already linked
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -111,6 +111,7 @@ import System.Win32.Info (getSystemDirectory)
#endif
import GHC.Utils.Exception
+import GHC.Unit.Module.Graph
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -640,7 +641,10 @@ initLinkDepsOpts hsc_env = opts
opts = LinkDepsOpts
{ ldObjSuffix = objectSuf dflags
, ldOneShotMode = isOneShot (ghcMode dflags)
- , ldModuleGraph = hsc_mod_graph hsc_env
+ -- MP: This is very inefficient as it destroys sharing of
+ -- calculating transitive dependencies. it would be better if we
+ -- were explicit about requesting modules at a specific stage.
+ , ldModuleGraph = collapseModuleGraph $ hsc_mod_graph hsc_env
, ldUnitEnv = hsc_unit_env hsc_env
, ldPprOpts = initSDocContext dflags defaultUserStyle
, ldFinderCache = hsc_FC hsc_env
=====================================
compiler/GHC/Rename/Splice.hs
=====================================
@@ -974,7 +974,7 @@ checkThLocalName name
= return ()
| otherwise
- = do { pprTraceM "checkThLocalName" (ppr name)
+ = do { --pprTraceM "checkThLocalName" (ppr name)
; mb_local_use <- getStageAndBindLevel name
; case mb_local_use of {
Nothing -> return () ; -- Not a locally-bound thing
@@ -983,9 +983,9 @@ checkThLocalName name
; cur_mod <- extractModule <$> getGblEnv
; let is_local = nameIsLocalOrFrom cur_mod name
-- ; checkWellStaged (StageCheckSplice name) bind_lvl use_lvl
- ; pprTraceM "checkThLocalName" (ppr name <+> ppr bind_lvl
- <+> ppr use_stage
- <+> ppr use_lvl)
+ --; pprTraceM "checkThLocalName" (ppr name <+> ppr bind_lvl
+ -- <+> ppr use_stage
+ -- <+> ppr use_lvl)
; dflags <- getDynFlags
; checkCrossStageLifting dflags (StageCheckSplice name) top_lvl is_local bind_lvl use_stage use_lvl name } } }
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -1060,7 +1060,7 @@ checkThLocalId :: Id -> TcM ()
-- Here we just add constraints for cross-stage lifting
checkThLocalId id
= do { mb_local_use <- getStageAndBindLevel (idName id)
- ; pprTraceM "local" (ppr id $$ ppr mb_local_use)
+-- ; pprTraceM "local" (ppr id $$ ppr mb_local_use)
; case mb_local_use of
Just (top_lvl, bind_lvl, use_stage)
| thLevel use_stage `notElem` bind_lvl
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -1455,10 +1455,10 @@ checkWellStagedInstanceWhat what
= do
cur_mod <- extractModule <$> getGblEnv
gbl_env <- getGblEnv
- pprTraceM "checkWellStaged" (ppr what)
- pprTraceM "checkWellStaged" (ppr (tcg_bind_env gbl_env))
- pprTraceM "checkWellStaged"
- (ppr (lookupNameEnv (tcg_bind_env gbl_env) (idName dfun_id)))
+-- pprTraceM "checkWellStaged" (ppr what)
+-- pprTraceM "checkWellStaged" (ppr (tcg_bind_env gbl_env))
+-- pprTraceM "checkWellStaged"
+-- (ppr (lookupNameEnv (tcg_bind_env gbl_env) (idName dfun_id)))
return $ (,isLocalId dfun_id) <$> (lookupNameEnv (tcg_bind_env gbl_env) (idName dfun_id))
return $ case lookupNameEnv (tcg_bind_env gbl_env) (idName dfun_id) of
-- The instance comes from HPT imported module
@@ -1466,7 +1466,9 @@ checkWellStagedInstanceWhat what
Nothing ->
if isLocalId dfun_id
then Just ( (Set.singleton outerLevel, True) )
- else Just ( (Set.singleton impLevel, False) )
+ -- TODO: Instances coming from external packages also need somehow
+ -- to deal with splice imports
+ else Just ( (Set.fromList [impLevel, outerLevel], False) )
-- return $ Just (TcM.topIdLvl dfun_id)
| BuiltinTypeableInstance tc <- what
= do
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -2082,16 +2082,27 @@ getStageAndBindLevel name
; case lookupNameEnv (getLclEnvThBndrs env) name of
Nothing -> do
lvls <- getExternalBindLvl name
- pprTraceM "lvls" (ppr name $$ ppr lvls $$ ppr (getLclEnvThStage env))
- return (Just (TopLevel, lvls, getLclEnvThStage env))
+ if Set.empty == lvls
+ -- This case happens when code is generated for identifiers which are not
+ -- in scope.
+ --
+ -- TODO: What happens if someone generates [|| GHC.Magic.dataToTag# ||]
+ then do
+ env <- getGlobalRdrEnv
+ pprTrace "NO_LVLS" (ppr env $$ ppr name) (return Nothing)
+ else return (Just (TopLevel, lvls, getLclEnvThStage env))
Just (top_lvl, bind_lvl) -> return (Just (top_lvl, Set.singleton bind_lvl, getLclEnvThStage env)) }
getExternalBindLvl :: Name -> TcRn (Set.Set ThLevel)
getExternalBindLvl name = do
env <- getGlobalRdrEnv
+ mod <- getModule
case lookupGRE_Name env name of
Just gre -> return $ (Set.map convert_lvl (greStages gre))
- Nothing -> return Set.empty
+ Nothing ->
+ if nameIsLocalOrFrom mod name
+ then return $ Set.singleton outerLevel
+ else pprTrace "NO LVLS" (ppr name) (return Set.empty) -- pprPanic "getExternalBindLvl" (ppr env $$ ppr name $$ ppr (nameSrcSpan name))
where
convert_lvl NormalStage = thLevel topStage
convert_lvl SpliceStage = thLevel topSpliceStage
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -630,7 +630,9 @@ greInfo :: GlobalRdrElt -> GREInfo
greInfo = gre_info
greStages :: GlobalRdrElt -> Set.Set ImportStage
-greStages g = Set.fromList (bagToList (fmap (is_staged . is_decl) (gre_imp g)))
+greStages g =
+ if gre_lcl g then Set.singleton NormalStage
+ else Set.fromList (bagToList (fmap (is_staged . is_decl) (gre_imp g)))
-- | See Note [Parents]
data Parent = NoParent
=====================================
compiler/GHC/Unit/Module/Graph.hs
=====================================
@@ -43,7 +43,11 @@ module GHC.Unit.Module.Graph
, ModuleStage
, zeroStage
, todoStage
+ , moduleStageToThLevel
+ , incModuleStage
+ , decModuleStage
, collapseModuleGraph
+ , collapseModuleGraphNodes
)
where
@@ -141,21 +145,28 @@ nodeKeyModName :: NodeKey -> Maybe ModuleName
nodeKeyModName (NodeKey_Module mk) = Just (gwib_mod $ mnkModuleName mk)
nodeKeyModName _ = Nothing
-type ModuleStage = Int
+newtype ModuleStage = ModuleStage Int deriving (Eq, Ord)
+
+instance Outputable ModuleStage where
+ ppr (ModuleStage p) = ppr p
zeroStage :: ModuleStage
-zeroStage = 0
+zeroStage = ModuleStage 1
todoStage :: HasCallStack => ModuleStage
todoStage = pprTrace "todoStage" callStackDoc zeroStage
+moduleStageToThLevel (ModuleStage m) = m
+incModuleStage (ModuleStage m) = ModuleStage (m + 1)
+decModuleStage (ModuleStage m) = ModuleStage (m - 1)
+
data ModNodeKeyWithUid = ModNodeKeyWithUid { mnkModuleName :: !ModuleNameWithIsBoot
, mnkLevel :: !ModuleStage
, mnkUnitId :: !UnitId } deriving (Eq, Ord)
instance Outputable ModNodeKeyWithUid where
ppr (ModNodeKeyWithUid mnwib lvl uid)
- | lvl == 0 = ppr uid <> colon <> ppr mnwib
+ | lvl == zeroStage = ppr uid <> colon <> ppr mnwib
| otherwise = ppr uid <> colon <> ppr mnwib <> text "@" <> ppr lvl
-- | A '@ModuleGraph@' contains all the nodes from the home package (only). See
@@ -256,9 +267,11 @@ extendMG' mg = \case
mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph
mkModuleGraph = foldr (flip extendMG') emptyMG
+collapseModuleGraph = mkModuleGraph . collapseModuleGraphNodes . mgModSummaries'
+
-- Collapse information about levels and map everything to level 0
-collapseModuleGraph :: [ModuleGraphNode] -> [ModuleGraphNode]
-collapseModuleGraph m = nub $ map go m
+collapseModuleGraphNodes :: [ModuleGraphNode] -> [ModuleGraphNode]
+collapseModuleGraphNodes m = nub $ map go m
where
go (ModuleNode deps _lvl ms) = ModuleNode (nub $ map collapseNodeKey deps) zeroStage ms
go (LinkNode deps uid) = LinkNode (nub $ map collapseNodeKey deps) uid
@@ -311,7 +324,7 @@ showModMsg dflags recomp (ModuleNode _ lvl mod_summary) =
then text mod_str
else hsep $
[ text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' ')
- , int lvl
+ , (if lvl == zeroStage then empty else ppr lvl)
, char '('
, text (op $ msHsFilePath mod_summary) <> char ','
, message, char ')' ]
@@ -351,7 +364,7 @@ nodeDependencies :: Bool -> ModuleGraphNode -> [NodeKey]
nodeDependencies drop_hs_boot_nodes = \case
LinkNode deps _uid -> deps
InstantiationNode uid iuid ->
- NodeKey_Module . (\mod -> ModNodeKeyWithUid (GWIB mod NotBoot) 0 uid) <$> uniqDSetToList (instUnitHoles iuid)
+ NodeKey_Module . (\mod -> ModNodeKeyWithUid (GWIB mod NotBoot) zeroStage uid) <$> uniqDSetToList (instUnitHoles iuid)
ModuleNode deps _lvl _ms ->
map drop_hs_boot deps
where
=====================================
testsuite/tests/bytecode/T24634/Makefile
=====================================
@@ -4,14 +4,14 @@ include $(TOP)/mk/test.mk
# This case loads bytecode from the interface file written in the second invocation.
T24634a:
- $(TEST_HC) -c hello_c.c -o hello_c.o
- $(TEST_HC) -c -fbyte-code-and-object-code -fno-omit-interface-pragmas Hello.hs
- $(TEST_HC) -fprefer-byte-code -fbyte-code-and-object-code -fno-ignore-interface-pragmas hello_c.o Main.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c hello_c.c -o hello_c.o
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -fbyte-code-and-object-code -fno-omit-interface-pragmas Hello.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -fprefer-byte-code -fbyte-code-and-object-code -fno-ignore-interface-pragmas hello_c.o Main.hs
./Main
# This case uses the bytecode generated in 'runHscBackendPhase', not involving the interface, since 'Hello' is compiled
# in the same invocation as 'Main'.
T24634b:
- $(TEST_HC) -c hello_c.c -o hello_c.o
- $(TEST_HC) -fprefer-byte-code -fbyte-code-and-object-code -fno-ignore-interface-pragmas hello_c.o Hello.hs Main.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c hello_c.c -o hello_c.o
+ '$(TEST_HC)' $(TEST_HC_OPTS) -fprefer-byte-code -fbyte-code-and-object-code -fno-ignore-interface-pragmas hello_c.o Hello.hs Main.hs
./Main
=====================================
testsuite/tests/bytecode/T25090/Makefile
=====================================
@@ -4,18 +4,18 @@ include $(TOP)/mk/test.mk
# Verify that the object files aren't linked by clobbering them.
T25090a:
- $(TEST_HC) -c -fbyte-code-and-object-code C.hs-boot
- $(TEST_HC) -c -fbyte-code-and-object-code B.hs
- $(TEST_HC) -c -fbyte-code-and-object-code C.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -fbyte-code-and-object-code C.hs-boot
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -fbyte-code-and-object-code B.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -fbyte-code-and-object-code C.hs
echo 'corrupt' > B.o
echo 'corrupt' > C.o
echo 'corrupt' > C.o-boot
- $(TEST_HC) -c -fbyte-code-and-object-code D.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -fbyte-code-and-object-code D.hs
echo 'corrupt' > D.o
- $(TEST_HC) -c -fbyte-code-and-object-code -fprefer-byte-code A.hs
- $(TEST_HC) -fbyte-code-and-object-code -fprefer-byte-code A.o -o exe
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -fbyte-code-and-object-code -fprefer-byte-code A.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -fbyte-code-and-object-code -fprefer-byte-code A.o -o exe
./exe
T25090b:
- $(TEST_HC) -fbyte-code-and-object-code -fprefer-byte-code A -o exe -v0
+ '$(TEST_HC)' $(TEST_HC_OPTS) -fbyte-code-and-object-code -fprefer-byte-code A -o exe -v0
./exe
=====================================
testsuite/tests/codeGen/should_compile/Makefile
=====================================
@@ -79,4 +79,4 @@ T17648:
grep -F 'f :: T GHC.Types.Int -> () [TagSig' >/dev/null
T25166:
- '$(TEST_HC)' -O2 -dno-typeable-binds -ddump-cmm T25166.hs | awk '/foo_closure/{flag=1}/}]/{flag=0}flag'
+ '$(TEST_HC)' $(TEST_HC_OPTS) -O2 -dno-typeable-binds -ddump-cmm T25166.hs | awk '/foo_closure/{flag=1}/}]/{flag=0}flag'
=====================================
testsuite/tests/splice-imports/SI03.stderr
=====================================
@@ -1,7 +1,5 @@
-
-SI03.hs:8:11: error:
- • Splice import
- sid
- imported from ‘SI01A’ at SI03.hs:5:1-12
- (and originally defined at SI01A.hs:3:1-3)
+SI03.hs:8:11: error: [GHC-28914]
+ • Stage error: ‘sid’ is bound at stage {1} but used at stage 0
+ Hint: quoting [| sid |] or an enclosing expression would allow the quotation to be used in an earlier stage
• In the untyped splice: $(sid [| pure () |])
+
=====================================
testsuite/tests/splice-imports/SI05.stderr
=====================================
@@ -1,11 +1,16 @@
+SI05.hs:9:11: error: [GHC-28914]
+ • Stage error: ‘SI01A.sid’ is bound at stage {1} but used at stage 0
+ Hint: quoting [| SI01A.sid |] or an enclosing expression would allow the quotation to be used in an earlier stage
+ • In the untyped splice: $(sid [| pure () |])
-SI05.hs:9:11: error:
- • Ambiguous occurrence ‘sid’
+SI05.hs:9:11: error: [GHC-87543]
+ • Ambiguous occurrence ‘sid’.
It could refer to
either ‘SI01A.sid’,
imported from ‘SI01A’ at SI05.hs:5:1-12
- (and originally defined at SI01A.hs:3:1-3)
+ (and originally defined at SI01A.hs:3:1-3),
or ‘SI05A.sid’,
imported from ‘SI05A’ at SI05.hs:6:1-19
- (and originally defined at SI05A.hs:3:1-3)
+ (and originally defined at SI05A.hs:3:1-3).
• In the untyped splice: $(sid [| pure () |])
+
=====================================
testsuite/tests/splice-imports/SI07.stderr
=====================================
@@ -1,3 +1,3 @@
-[1 of 3] Compiling SI05A ( SI05A.hs, SI05A.o, SI05A.dyn_o )
-[2 of 3] Compiling SI07A ( SI07A.hs, nothing, SI07A.dyn_o )
-[3 of 3] Compiling SI07 ( SI07.hs, SI07.o, SI07.dyn_o )
+[1 of 3] Compiling SI05A ( SI05A.hs, SI05A.o )
+[2 of 3] Compiling SI07A ( SI07A.hs, SI07A.o )
+[3 of 3] Compiling SI07 ( SI07.hs, nothing )
=====================================
testsuite/tests/splice-imports/SI08.hs
=====================================
@@ -4,6 +4,8 @@ module SI08 where
import InstanceA ()
import splice ClassA
+import ClassA
+import splice Prelude (const)
e :: X
-- Uses a non-splice imported instance
=====================================
testsuite/tests/splice-imports/SI08.stderr
=====================================
@@ -1,6 +1,6 @@
-
-SI08.hs:10:25: error:
- • No instance for (C X) arising from a use of ‘x’
+SI08.hs:12:25: error: [GHC-28914]
+ • Stage error: instance for ‘C X’ is bound at stage {1} but used at stage 0
• In the second argument of ‘const’, namely ‘(x vx)’
In the expression: const [| x vx |] (x vx)
In the untyped splice: $(const [| x vx |] (x vx))
+
=====================================
testsuite/tests/splice-imports/SI11.stderr
=====================================
@@ -0,0 +1,5 @@
+SI11.hs:11:10: error: [GHC-28914]
+ • Stage error: ‘X’ is bound at stage {1} but used at stage 2
+ Hint: quoting [| X |] or an enclosing expression would allow the quotation to be used in an earlier stage
+ • In the Template Haskell quotation [| X |]
+
=====================================
testsuite/tests/splice-imports/SI12.stderr
=====================================
@@ -0,0 +1,5 @@
+SI12.hs:6:22: error: [GHC-28914]
+ • Stage error: ‘t’ is bound at stage {1} but used at stage 2
+ Hint: quoting [| t |] or an enclosing expression would allow the quotation to be used in an earlier stage
+ • In the Template Haskell quotation [| t |]
+
=====================================
testsuite/tests/splice-imports/SI14.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE ExplicitStageImports #-}
+module SI14 where
+
+import Language.Haskell.TH.Syntax (Lift)
+
+data A = A deriving Lift
=====================================
testsuite/tests/splice-imports/SI14.stderr
=====================================
@@ -0,0 +1,10 @@
+SI14.hs:7:21: error: [GHC-28914]
+ • Stage error: ‘A’ is bound at stage {1} but used at stage 2
+ Hint: quoting [| A |] or an enclosing expression would allow the quotation to be used in an earlier stage
+ • In the Template Haskell typed quotation [|| A ||]
+
+SI14.hs:7:21: error: [GHC-28914]
+ • Stage error: ‘A’ is bound at stage {1} but used at stage 2
+ Hint: quoting [| A |] or an enclosing expression would allow the quotation to be used in an earlier stage
+ • In the Template Haskell quotation [| A |]
+
=====================================
testsuite/tests/splice-imports/SI15.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE NoPathCSP #-}
+{-# LANGUAGE DeriveLift #-}
+module SI15 where
+
+import Language.Haskell.TH.Syntax (Lift)
+
+data A = A deriving Lift
=====================================
testsuite/tests/splice-imports/all.T
=====================================
@@ -17,4 +17,6 @@ test('SI10', [extra_files(["ClassA.hs", "InstanceA.hs"])], multimod_compile, ['S
test('SI11', normal, compile_fail, [''])
test('SI12', normal, compile_fail, [''])
test('SI13', normal, compile, [''])
+test('SI14', normal, compile_fail, [''])
+test('SI15', normal, compile_fail, [''])
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1840,7 +1840,7 @@ instance ExactPrint (ImportDecl GhcPs) where
= (ideclExt idecl) { ideclAnn = setAnchorEpa (ideclAnn $ ideclExt idecl) anc ts cs} }
exact (ImportDecl (XImportDeclPass ann msrc impl)
- modname mpkg src safeflag qualFlag mAs hiding) = do
+ modname mpkg src st safeflag qualFlag mAs hiding) = do
ann0 <- markLensKw' ann limportDeclAnnImport AnnImport
let (EpAnn _anc an _cs) = ann0
@@ -1902,7 +1902,7 @@ instance ExactPrint (ImportDecl GhcPs) where
}
return (ImportDecl (XImportDeclPass (EpAnn anc' an2 cs') msrc impl)
- modname' mpkg src safeflag qualFlag mAs' hiding')
+ modname' mpkg src st safeflag qualFlag mAs' hiding')
-- ---------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e43c366192606df3f0d96ccd1984790b460e065...3a654716d968a18b1fec755886f7c03e94a02eb3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e43c366192606df3f0d96ccd1984790b460e065...3a654716d968a18b1fec755886f7c03e94a02eb3
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/20241024/1c6b266e/attachment-0001.html>
More information about the ghc-commits
mailing list