diff options
45 files changed, 487 insertions, 91 deletions
diff --git a/compiler/backpack/BkpSyn.hs b/compiler/backpack/BkpSyn.hs index e019d03b24..a7e4db30dd 100644 --- a/compiler/backpack/BkpSyn.hs +++ b/compiler/backpack/BkpSyn.hs @@ -68,7 +68,12 @@ type LHsUnitDecl n = Located (HsUnitDecl n) -- | An include of another unit data IncludeDecl n = IncludeDecl { idUnitId :: LHsUnitId n, - idModRenaming :: Maybe [ LRenaming ] + idModRenaming :: Maybe [ LRenaming ], + -- | Is this a @dependency signature@ include? If so, + -- we don't compile this include when we instantiate this + -- unit (as there should not be any modules brought into + -- scope.) + idSignatureInclude :: Bool } -- | Rename a module from one name to another. The identity renaming diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs index fc46ce1752..595cb25174 100644 --- a/compiler/backpack/DriverBkp.hs +++ b/compiler/backpack/DriverBkp.hs @@ -104,11 +104,20 @@ computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ]) reqs = uniqDSetToList (unionManyUniqDSets (map (get_reqs . unLoc) (hsunitBody unit))) get_reqs (DeclD SignatureD (L _ modname) _) = unitUniqDSet modname get_reqs (DeclD ModuleD _ _) = emptyUniqDSet - get_reqs (IncludeD (IncludeDecl (L _ hsuid) _)) = + get_reqs (IncludeD (IncludeDecl (L _ hsuid) _ _)) = unitIdFreeHoles (convertHsUnitId hsuid) -- | Tiny enum for all types of Backpack operations we may do. -data SessionType = ExeSession | TcSession | CompSession +data SessionType + -- | A compilation operation which will result in a + -- runnable executable being produced. + = ExeSession + -- | A type-checking operation which produces only + -- interface files, no object files. + | TcSession + -- | A compilation operation which produces both + -- interface files and object files. + | CompSession deriving (Eq) -- | Create a temporary Session to do some sort of type checking or @@ -208,11 +217,19 @@ compileUnit cid insts = do lunit <- getSource cid buildUnit CompSession cid insts lunit --- Invariant: this NEVER returns InstalledUnitId -hsunitDeps :: HsUnit HsComponentId -> [(UnitId, ModRenaming)] -hsunitDeps unit = concatMap get_dep (hsunitBody unit) +-- | Compute the dependencies with instantiations of a syntactic +-- HsUnit; e.g., wherever you see @dependency p[A=<A>]@ in a +-- unit file, return the 'UnitId' corresponding to @p[A=<A>]@. +-- The @include_sigs@ parameter controls whether or not we also +-- include @dependency signature@ declarations in this calculation. +-- +-- Invariant: this NEVER returns InstalledUnitId. +hsunitDeps :: Bool {- include sigs -} -> HsUnit HsComponentId -> [(UnitId, ModRenaming)] +hsunitDeps include_sigs unit = concatMap get_dep (hsunitBody unit) where - get_dep (L _ (IncludeD (IncludeDecl (L _ hsuid) mb_lrn))) = [(convertHsUnitId hsuid, go mb_lrn)] + get_dep (L _ (IncludeD (IncludeDecl (L _ hsuid) mb_lrn is_sig))) + | include_sigs || not is_sig = [(convertHsUnitId hsuid, go mb_lrn)] + | otherwise = [] where go Nothing = ModRenaming True [] go (Just lrns) = ModRenaming False (map convRn lrns) @@ -223,7 +240,11 @@ hsunitDeps unit = concatMap get_dep (hsunitBody unit) buildUnit :: SessionType -> ComponentId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM () buildUnit session cid insts lunit = do - let deps_w_rns = hsunitDeps (unLoc lunit) + -- NB: include signature dependencies ONLY when typechecking. + -- If we're compiling, it's not necessary to recursively + -- compile a signature since it isn't going to produce + -- any object files. + let deps_w_rns = hsunitDeps (session == TcSession) (unLoc lunit) raw_deps = map fst deps_w_rns dflags <- getDynFlags -- The compilation dependencies are just the appropriately filled @@ -273,11 +294,7 @@ buildUnit session cid insts lunit = do obj_files = concatMap getOfiles linkables let compat_fs = (case cid of ComponentId fs -> fs) - cand_compat_pn = PackageName compat_fs - compat_pn = case session of - TcSession -> cand_compat_pn - _ | [] <- insts -> cand_compat_pn - | otherwise -> PackageName compat_fs + compat_pn = PackageName compat_fs return InstalledPackageInfo { -- Stub data @@ -336,7 +353,7 @@ buildUnit session cid insts lunit = do compileExe :: LHsUnit HsComponentId -> BkpM () compileExe lunit = do msgUnitId mainUnitId - let deps_w_rns = hsunitDeps (unLoc lunit) + let deps_w_rns = hsunitDeps False (unLoc lunit) deps = map fst deps_w_rns -- no renaming necessary forM_ (zip [1..] deps) $ \(i, dep) -> @@ -562,7 +579,8 @@ renameHsUnits dflags m units = map (fmap renameHsUnit) units renameHsUnitDecl (IncludeD idecl) = IncludeD IncludeDecl { idUnitId = fmap renameHsUnitId (idUnitId idecl), - idModRenaming = idModRenaming idecl + idModRenaming = idModRenaming idecl, + idSignatureInclude = idSignatureInclude idecl } renameHsUnitId :: HsUnitId PackageName -> HsUnitId HsComponentId @@ -713,7 +731,9 @@ hsModuleToModSummary :: PackageName -> Located (HsModule RdrName) -> BkpM ModSummary hsModuleToModSummary pn hsc_src modname - hsmod@(L loc (HsModule _ _ imps _ _ _)) = do + hsmod = do + let imps = hsmodImports (unLoc hsmod) + loc = getLoc hsmod hsc_env <- getSession -- Sort of the same deal as in DriverPipeline's getLocation -- Use the PACKAGE NAME to find the location diff --git a/compiler/backpack/NameShape.hs b/compiler/backpack/NameShape.hs index ea6e193629..0804d71ebb 100644 --- a/compiler/backpack/NameShape.hs +++ b/compiler/backpack/NameShape.hs @@ -7,6 +7,7 @@ module NameShape( extendNameShape, nameShapeExports, substNameShape, + maybeSubstNameShape, ) where #include "HsVersions.h" @@ -134,6 +135,15 @@ substNameShape ns n | nameModule n == ns_module ns | otherwise = n +-- | Like 'substNameShape', but returns @Nothing@ if no substitution +-- works. +maybeSubstNameShape :: NameShape -> Name -> Maybe Name +maybeSubstNameShape ns n + | nameModule n == ns_module ns + = lookupOccEnv (ns_map ns) (occName n) + | otherwise + = Nothing + -- | The 'Module' of any 'Name's a 'NameShape' has action over. ns_module :: NameShape -> Module ns_module = mkHoleModule . ns_mod_name diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs index 4861628764..0a95849646 100644 --- a/compiler/backpack/RnModIface.hs +++ b/compiler/backpack/RnModIface.hs @@ -9,10 +9,13 @@ module RnModIface( rnModIface, rnModExports, + tcRnModIface, + tcRnModExports, ) where #include "HsVersions.h" +import SrcLoc import Outputable import HscTypes import Module @@ -21,6 +24,7 @@ import Avail import IfaceSyn import FieldLabel import Var +import ErrUtils import Name import TcRnMonad @@ -34,9 +38,39 @@ import DynFlags import qualified Data.Traversable as T +import Bag +import Data.IORef import NameShape import IfaceEnv +tcRnMsgMaybe :: IO (Either ErrorMessages a) -> TcM a +tcRnMsgMaybe do_this = do + r <- liftIO $ do_this + case r of + Left errs -> do + addMessages (emptyBag, errs) + failM + Right x -> return x + +tcRnModIface :: [(ModuleName, Module)] -> Maybe NameShape -> ModIface -> TcM ModIface +tcRnModIface x y z = do + hsc_env <- getTopEnv + tcRnMsgMaybe $ rnModIface hsc_env x y z + +tcRnModExports :: [(ModuleName, Module)] -> ModIface -> TcM [AvailInfo] +tcRnModExports x y = do + hsc_env <- getTopEnv + tcRnMsgMaybe $ rnModExports hsc_env x y + +failWithRn :: SDoc -> ShIfM a +failWithRn doc = do + errs_var <- fmap sh_if_errs getGblEnv + dflags <- getDynFlags + errs <- readTcRef errs_var + -- TODO: maybe associate this with a source location? + writeTcRef errs_var (errs `snocBag` mkPlainErrMsg dflags noSrcSpan doc) + failM + -- | What we have a generalized ModIface, which corresponds to -- a module that looks like p[A=<A>]:B. We need a *specific* ModIface, e.g. -- p[A=q():A]:B (or maybe even p[A=<B>]:B) which we load @@ -58,7 +92,7 @@ import IfaceEnv -- should be Foo.T; then we'll also rename this (this is used -- when loading an interface to merge it into a requirement.) rnModIface :: HscEnv -> [(ModuleName, Module)] -> Maybe NameShape - -> ModIface -> IO ModIface + -> ModIface -> IO (Either ErrorMessages ModIface) rnModIface hsc_env insts nsubst iface = do initRnIface hsc_env iface insts nsubst $ do mod <- rnModule (mi_module iface) @@ -81,7 +115,7 @@ rnModIface hsc_env insts nsubst iface = do -- | Rename just the exports of a 'ModIface'. Useful when we're doing -- shaping prior to signature merging. -rnModExports :: HscEnv -> [(ModuleName, Module)] -> ModIface -> IO [AvailInfo] +rnModExports :: HscEnv -> [(ModuleName, Module)] -> ModIface -> IO (Either ErrorMessages [AvailInfo]) rnModExports hsc_env insts iface = initRnIface hsc_env iface insts Nothing $ mapM rnAvailInfo (mi_exports iface) @@ -94,19 +128,28 @@ rnModExports hsc_env insts iface ************************************************************************ -} --- | Initialize the 'ShIfM' monad. +-- | Run a computation in the 'ShIfM' monad. initRnIface :: HscEnv -> ModIface -> [(ModuleName, Module)] -> Maybe NameShape - -> ShIfM a -> IO a -initRnIface hsc_env iface insts nsubst do_this = - let hsubst = listToUFM insts - rn_mod = renameHoleModule (hsc_dflags hsc_env) hsubst + -> ShIfM a -> IO (Either ErrorMessages a) +initRnIface hsc_env iface insts nsubst do_this = do + errs_var <- newIORef emptyBag + let dflags = hsc_dflags hsc_env + hsubst = listToUFM insts + rn_mod = renameHoleModule dflags hsubst env = ShIfEnv { sh_if_module = rn_mod (mi_module iface), sh_if_semantic_module = rn_mod (mi_semantic_module iface), sh_if_hole_subst = listToUFM insts, - sh_if_shape = nsubst + sh_if_shape = nsubst, + sh_if_errs = errs_var } - in initTcRnIf 'c' hsc_env env () do_this + -- Modeled off of 'initTc' + res <- initTcRnIf 'c' hsc_env env () $ tryM do_this + msgs <- readIORef errs_var + case res of + Left _ -> return (Left msgs) + Right r | not (isEmptyBag msgs) -> return (Left msgs) + | otherwise -> return (Right r) -- | Environment for 'ShIfM' monads. data ShIfEnv = ShIfEnv { @@ -123,7 +166,9 @@ data ShIfEnv = ShIfEnv { -- the names in the interface. If this is 'Nothing', then -- we just load the target interface and look at the export -- list to determine the renaming. - sh_if_shape :: Maybe NameShape + sh_if_shape :: Maybe NameShape, + -- Mutable reference to keep track of errors (similar to 'tcl_errs') + sh_if_errs :: IORef ErrorMessages } getHoleSubst :: ShIfM ShHoleSubst @@ -215,10 +260,21 @@ rnIfaceGlobal n = do , isHoleModule m' -- NB: this could be Nothing for computeExports, we have -- nothing to say. - -> do fmap (case mb_nsubst of - Nothing -> id - Just nsubst -> substNameShape nsubst) - $ setNameModule (Just m') n + -> do n' <- setNameModule (Just m') n + case mb_nsubst of + Nothing -> return n' + Just nsubst -> + case maybeSubstNameShape nsubst n' of + -- TODO: would love to have context + -- TODO: This will give an unpleasant message if n' + -- is a constructor; then we'll suggest adding T + -- but it won't work. + Nothing -> failWithRn $ vcat [ + text "The identifier" <+> ppr (occName n') <+> + text "does not exist in the local signature.", + parens (text "Try adding it to the export list of the hsig file.") + ] + Just n'' -> return n'' -- Fastpath: we are renaming p[H=<H>]:A.T, in which case the -- export list is irrelevant. | not (isHoleModule m) @@ -239,7 +295,14 @@ rnIfaceGlobal n = do iface <- liftIO . initIfaceCheck (text "rnIfaceGlobal") hsc_env $ loadSysInterface (text "rnIfaceGlobal") m'' let nsubst = mkNameShape (moduleName m) (mi_exports iface) - return (substNameShape nsubst n) + case maybeSubstNameShape nsubst n of + Nothing -> failWithRn $ vcat [ + text "The identifier" <+> ppr (occName n) <+> + -- NB: report m' because it's more user-friendly + text "does not exist in the signature for" <+> ppr m', + parens (text "Try adding it to the export list in that hsig file.") + ] + Just n' -> return n' -- | Rename a DFun name. Here is where we ensure that DFuns have the correct -- module as described in Note [Bogus DFun renamings]. diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 921943afb9..7c138c473d 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -75,6 +75,7 @@ import RnModIface import UniqDSet import Control.Monad +import Control.Exception import Data.IORef import System.FilePath @@ -540,8 +541,12 @@ computeInterface doc_str hi_boot_file mod0 = do case r of Succeeded (iface0, path) -> do hsc_env <- getTopEnv - r <- liftIO (rnModIface hsc_env (indefUnitIdInsts (indefModuleUnitId indef)) Nothing iface0) - return (Succeeded (r, path)) + r <- liftIO $ + rnModIface hsc_env (indefUnitIdInsts (indefModuleUnitId indef)) + Nothing iface0 + case r of + Right x -> return (Succeeded (x, path)) + Left errs -> liftIO . throwIO . mkSrcErr $ errs Failed err -> return (Failed err) (mod, _) -> findAndReadIface doc_str mod hi_boot_file diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index ceb566ca6d..6dd16f6c2f 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -74,8 +74,10 @@ getImports dflags buf filename source_filename = do then throwIO $ mkSrcErr errs else case rdr_module of - L _ (HsModule mb_mod _ imps _ _ _) -> + L _ hsmod -> let + mb_mod = hsmodName hsmod + imps = hsmodImports hsmod main_loc = srcLocSpan (mkSrcLoc (mkFastString source_filename) 1 1) mod = mb_mod `orElse` L main_loc mAIN_NAME (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 2fc7341c63..eb56a54209 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -414,7 +414,7 @@ hscTypecheck keep_rn mod_summary mb_rdr_module = do if hsc_src == HsigFile then do (iface, _, _) <- liftIO $ hscSimpleIface hsc_env tc_result0 Nothing ioMsgMaybe $ - tcRnMergeSignatures hsc_env (tcg_top_loc tc_result0) iface + tcRnMergeSignatures hsc_env (tcg_top_loc tc_result0) hpm iface else return tc_result0 -- wrapper around tcRnModule to handle safe haskell extras diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index fadb8e7b57..5119ab439c 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -643,7 +643,12 @@ unitdecl :: { LHsUnitDecl PackageName } { sL1 $2 $ DeclD SignatureD $3 Nothing } | 'dependency' unitid mayberns { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2 - , idModRenaming = $3 }) } + , idModRenaming = $3 + , idSignatureInclude = False }) } + | 'dependency' 'signature' unitid + { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $3 + , idModRenaming = Nothing + , idSignatureInclude = True }) } ----------------------------------------------------------------------------- -- Module Header diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs index 1cf3393605..7c44ef0831 100644 --- a/compiler/typecheck/TcBackpack.hs +++ b/compiler/typecheck/TcBackpack.hs @@ -17,6 +17,7 @@ module TcBackpack ( ) where import Packages +import TcRnExports import DynFlags import HsSyn import RdrName @@ -46,6 +47,7 @@ import FastString import Maybes import TcEnv import Var +import IfaceSyn import PrelNames import qualified Data.Map as Map @@ -311,18 +313,42 @@ tcRnCheckUnitId hsc_env uid = -- | Top-level driver for signature merging (run after typechecking -- an @hsig@ file). -tcRnMergeSignatures :: HscEnv -> RealSrcSpan -> ModIface +tcRnMergeSignatures :: HscEnv -> RealSrcSpan -> HsParsedModule -> ModIface -> IO (Messages, Maybe TcGblEnv) -tcRnMergeSignatures hsc_env real_loc iface = +tcRnMergeSignatures hsc_env real_loc hsmod iface = withTiming (pure dflags) (text "Signature merging" <+> brackets (ppr this_mod)) (const ()) $ initTc hsc_env HsigFile False this_mod real_loc $ - mergeSignatures iface + mergeSignatures hsmod iface where dflags = hsc_dflags hsc_env this_mod = mi_module iface +thinModIface :: [AvailInfo] -> ModIface -> ModIface +thinModIface avails iface = + iface { + mi_exports = avails, + -- mi_fixities = ..., + -- mi_warns = ..., + -- mi_anns = ..., + -- TODO: The use of nameOccName here is a bit dodgy, because + -- perhaps there might be two IfaceTopBndr that are the same + -- OccName but different Name. Requires better understanding + -- of invariants here. + mi_decls = filter (decl_pred . snd) (mi_decls iface) + -- mi_insts = ..., + -- mi_fam_insts = ..., + } + where + occs = mkOccSet [ occName n + | a <- avails + , n <- availNames a ] + -- NB: Never drop DFuns + decl_pred IfaceId{ ifIdDetails = IfDFunId } = True + decl_pred decl = + nameOccName (ifName decl) `elemOccSet` occs + -- Note [Blank hsigs for all requirements] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- One invariant that a client of GHC must uphold is that there @@ -336,8 +362,8 @@ tcRnMergeSignatures hsc_env real_loc iface = -- from 'requirementMerges' into this signature, producing -- a final 'TcGblEnv' that matches the local signature and -- all required signatures. -mergeSignatures :: ModIface -> TcRn TcGblEnv -mergeSignatures lcl_iface0 = do +mergeSignatures :: HsParsedModule -> ModIface -> TcRn TcGblEnv +mergeSignatures hsmod lcl_iface0 = do -- The lcl_iface0 is the ModIface for the local hsig -- file, which is guaranteed to exist, see -- Note [Blank hsigs for all requirements] @@ -346,41 +372,68 @@ mergeSignatures lcl_iface0 = do tcg_env <- getGblEnv let outer_mod = tcg_mod tcg_env inner_mod = tcg_semantic_mod tcg_env + mb_exports = hsmodExports (unLoc (hpm_module hsmod)) -- STEP 1: Figure out all of the external signature interfaces -- we are going to merge in. let reqs = requirementMerges dflags (moduleName (tcg_mod tcg_env)) -- STEP 2: Read in the RAW forms of all of these interfaces - ireq_ifaces <- forM reqs $ \(IndefModule iuid mod_name) -> + ireq_ifaces0 <- forM reqs $ \(IndefModule iuid mod_name) -> fmap fst . withException . flip (findAndReadIface (text "mergeSignatures")) False $ fst (splitModuleInsts (mkModule (IndefiniteUnitId iuid) mod_name)) -- STEP 3: Get the unrenamed exports of all these interfaces, and - -- dO shaping on them. + -- do shaping on them. let extend_ns nsubst as = liftIO $ extendNameShape hsc_env nsubst as - gen_subst nsubst ((IndefModule iuid _), ireq_iface) = do + gen_subst (nsubst,ifaces) (imod@(IndefModule iuid _), ireq_iface) = do let insts = indefUnitIdInsts iuid - as1 <- liftIO $ rnModExports hsc_env insts ireq_iface - mb_r <- extend_ns nsubst as1 + as1 <- tcRnModExports insts ireq_iface + let inst_uid = fst (splitUnitIdInsts (IndefiniteUnitId iuid)) + pkg = getInstalledPackageDetails dflags inst_uid + rdr_env = mkGlobalRdrEnv (gresFromAvails Nothing as1) + (thinned_iface, as2) <- case mb_exports of + Just (L loc _) + | null (exposedModules pkg) -> setSrcSpan loc $ do + -- Suppress missing errors; we'll pick em up + -- when we test exports on the final thing + (msgs, mb_r) <- tryTc $ + setGblEnv tcg_env { + tcg_rdr_env = rdr_env + } $ exports_from_avail mb_exports rdr_env + (tcg_imports tcg_env) (tcg_semantic_mod tcg_env) + case mb_r of + Just (_, as2) -> return (thinModIface as2 ireq_iface, as2) + Nothing -> addMessages msgs >> failM + _ -> return (ireq_iface, as1) + mb_r <- extend_ns nsubst as2 case mb_r of Left err -> failWithTc err - Right nsubst' -> return nsubst' + Right nsubst' -> return (nsubst',(imod, thinned_iface):ifaces) nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0) - nsubst <- foldM gen_subst nsubst0 (zip reqs ireq_ifaces) - let exports = nameShapeExports nsubst - tcg_env <- return tcg_env { - tcg_rdr_env = mkGlobalRdrEnv (gresFromAvails Nothing exports), + (nsubst, rev_thinned_ifaces) <- foldM gen_subst (nsubst0, []) (zip reqs ireq_ifaces0) + let thinned_ifaces = reverse rev_thinned_ifaces + exports = nameShapeExports nsubst + rdr_env = mkGlobalRdrEnv (gresFromAvails Nothing exports) + setGblEnv tcg_env { + tcg_rdr_env = rdr_env, tcg_exports = exports, tcg_dus = usesOnly (availsToNameSetWithSelectors exports) - } + } $ do + tcg_env <- getGblEnv + + -- Make sure we didn't refer to anything that doesn't actually exist + _ <- exports_from_avail mb_exports rdr_env + (tcg_imports tcg_env) (tcg_semantic_mod tcg_env) + + failIfErrsM -- STEP 4: Rename the interfaces - ext_ifaces <- forM (zip reqs ireq_ifaces) $ \((IndefModule iuid _), ireq_iface) -> - liftIO (rnModIface hsc_env (indefUnitIdInsts iuid) (Just nsubst) ireq_iface) - lcl_iface <- liftIO $ rnModIface hsc_env (thisUnitIdInsts dflags) (Just nsubst) lcl_iface0 + ext_ifaces <- forM thinned_ifaces $ \((IndefModule iuid _), ireq_iface) -> + tcRnModIface (indefUnitIdInsts iuid) (Just nsubst) ireq_iface + lcl_iface <- tcRnModIface (thisUnitIdInsts dflags) (Just nsubst) lcl_iface0 let ifaces = lcl_iface : ext_ifaces -- STEP 5: Typecheck the interfaces @@ -591,8 +644,7 @@ checkImplements impl_mod (IndefModule uid mod_name) = do failIfErrsM -- STEP 4: Now that the export is complete, rename the interface... - hsc_env <- getTopEnv - sig_iface <- liftIO $ rnModIface hsc_env insts (Just nsubst) isig_iface + sig_iface <- tcRnModIface insts (Just nsubst) isig_iface -- STEP 5: ...and typecheck it. (Note that in both cases, the nsubst -- lets us determine how top-level identifiers should be handled.) diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs index 35ff65f92a..cedd4c7a56 100644 --- a/compiler/typecheck/TcRnExports.hs +++ b/compiler/typecheck/TcRnExports.hs @@ -1,7 +1,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} -module TcRnExports (tcRnExports) where +module TcRnExports (tcRnExports, exports_from_avail) where import HsSyn import PrelNames @@ -115,7 +115,8 @@ tcRnExports :: Bool -- False => no 'module M(..) where' header at all tcRnExports explicit_mod exports tcg_env@TcGblEnv { tcg_mod = this_mod, tcg_rdr_env = rdr_env, - tcg_imports = imports } + tcg_imports = imports, + tcg_src = hsc_src } = unsetWOptM Opt_WarnWarningsDeprecations $ -- Do not report deprecations arising from the export -- list, to avoid bleating about re-exporting a deprecated @@ -136,8 +137,14 @@ tcRnExports explicit_mod exports -- ToDo: the 'noLoc' here is unhelpful if 'main' -- turns out to be out of scope + ; let do_it = exports_from_avail real_exports rdr_env imports this_mod ; (rn_exports, final_avails) - <- exports_from_avail real_exports rdr_env imports this_mod + <- if hsc_src == HsigFile + then do (msgs, mb_r) <- tryTc do_it + case mb_r of + Just r -> return r + Nothing -> addMessages msgs >> failM + else checkNoErrs $ do_it ; let final_ns = availsToNameSetWithSelectors final_avails ; traceRn "rnExports: Exports:" (ppr final_avails) @@ -185,7 +192,7 @@ exports_from_avail Nothing rdr_env _imports _this_mod exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod = do ExportAccum ie_names _ exports - <- checkNoErrs $ foldAndRecoverM do_litem emptyExportAccum rdr_items + <- foldAndRecoverM do_litem emptyExportAccum rdr_items let final_exports = nubAvails exports -- Combine families return (Just ie_names, final_exports) where diff --git a/testsuite/tests/backpack/reexport/bkpreex01.bkp b/testsuite/tests/backpack/reexport/bkpreex01.bkp index fa6c36a4d1..9a1c5bd46b 100644 --- a/testsuite/tests/backpack/reexport/bkpreex01.bkp +++ b/testsuite/tests/backpack/reexport/bkpreex01.bkp @@ -1,11 +1,11 @@ unit h where - signature H(T) where + signature H where data T unit p where dependency h[H=<H>] module B(T(..)) where data T = T - signature H(T(..), f) where + signature H(module H, T(..)) where import B(T(..)) f :: a -> a module A(T) where diff --git a/testsuite/tests/backpack/reexport/bkpreex02.bkp b/testsuite/tests/backpack/reexport/bkpreex02.bkp index 0224b110ce..40e2bbbc45 100644 --- a/testsuite/tests/backpack/reexport/bkpreex02.bkp +++ b/testsuite/tests/backpack/reexport/bkpreex02.bkp @@ -10,7 +10,7 @@ unit timpl where unit q where dependency timpl dependency p[H=<H>,T=<T>] - signature T(T) where + signature T(module T, T) where import TImpl module A where import H diff --git a/testsuite/tests/backpack/reexport/bkpreex03.bkp b/testsuite/tests/backpack/reexport/bkpreex03.bkp index 69c2f55fce..69da4a4ddc 100644 --- a/testsuite/tests/backpack/reexport/bkpreex03.bkp +++ b/testsuite/tests/backpack/reexport/bkpreex03.bkp @@ -3,7 +3,7 @@ unit p where data M = M module M2 where data M = M - signature A(M) where + signature A(module A, M) where import M1 - signature A(M) where + signature A(module A, M) where import M2 diff --git a/testsuite/tests/backpack/reexport/bkpreex04.bkp b/testsuite/tests/backpack/reexport/bkpreex04.bkp index 610ebd90f3..4788b4ab04 100644 --- a/testsuite/tests/backpack/reexport/bkpreex04.bkp +++ b/testsuite/tests/backpack/reexport/bkpreex04.bkp @@ -3,5 +3,5 @@ unit p where data T signature B where data T - signature A(T) where + signature A(module A, T) where import B(T) diff --git a/testsuite/tests/backpack/reexport/bkpreex06.bkp b/testsuite/tests/backpack/reexport/bkpreex06.bkp index 2c04b61a38..77540971b7 100644 --- a/testsuite/tests/backpack/reexport/bkpreex06.bkp +++ b/testsuite/tests/backpack/reexport/bkpreex06.bkp @@ -1,7 +1,7 @@ unit p where signature A1 where data A = A { foo :: Int, bar :: Bool } - signature A2(foo) where + signature A2(module A2, foo) where import A1(foo) unit q where signature A2 where diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T index bb77278d26..299b28a7bc 100644 --- a/testsuite/tests/backpack/should_compile/all.T +++ b/testsuite/tests/backpack/should_compile/all.T @@ -34,3 +34,5 @@ test('bkp39', normal, backpack_compile, ['']) test('bkp40', normal, backpack_compile, ['']) test('bkp41', normal, backpack_compile, ['']) test('bkp42', normal, backpack_compile, ['']) +test('bkp43', normal, backpack_compile, ['']) +test('bkp44', normal, backpack_compile, ['']) diff --git a/testsuite/tests/backpack/should_compile/bkp15.bkp b/testsuite/tests/backpack/should_compile/bkp15.bkp index 6eb5364139..94678af234 100644 --- a/testsuite/tests/backpack/should_compile/bkp15.bkp +++ b/testsuite/tests/backpack/should_compile/bkp15.bkp @@ -15,10 +15,13 @@ unit p where class Eq a => Bloop a b | a -> b where data GMap a (v :: * -> *) :: * xa :: a -> a -> Bool - xa = (==) + -- TODO: Putting default definitions in the signature file + -- causes references to DFuns, which we choke on. These should + -- be disallowed. + -- xa = (==) y :: a -> a -> Ordering - default y :: Ord a => a -> a -> Ordering - y = compare + -- default y :: Ord a => a -> a -> Ordering + -- y = compare {-# MINIMAL xa | y #-} -- type instance Elem Int = Bool -- pattern Blub n = ("foo", n) @@ -37,10 +40,10 @@ unit q where class Eq a => Bloop a b | a -> b where data GMap a (v :: * -> *) :: * xa :: a -> a -> Bool - xa = (==) + -- xa = (==) y :: a -> a -> Ordering - default y :: Ord a => a -> a -> Ordering - y = compare + -- default y :: Ord a => a -> a -> Ordering + -- y = compare {-# MINIMAL xa | y #-} -- type instance Elem Int = Bool -- pattern Blub n = ("foo", n) @@ -73,10 +76,10 @@ unit h-impl where class Eq a => Bloop a b | a -> b where data GMap a (v :: * -> *) :: * xa :: a -> a -> Bool - xa = (==) + -- xa = (==) y :: a -> a -> Ordering - default y :: Ord a => a -> a -> Ordering - y = compare + -- default y :: Ord a => a -> a -> Ordering + -- y = compare {-# MINIMAL xa | y #-} unit s where dependency r[H=h-impl:H] diff --git a/testsuite/tests/backpack/should_compile/bkp15.stderr b/testsuite/tests/backpack/should_compile/bkp15.stderr index 904ab2d4cb..041b7fe4b8 100644 --- a/testsuite/tests/backpack/should_compile/bkp15.stderr +++ b/testsuite/tests/backpack/should_compile/bkp15.stderr @@ -3,14 +3,32 @@ bkp15.bkp:1:26: warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. [1 of 5] Processing p [1 of 1] Compiling H[sig] ( p/H.hsig, nothing ) + +bkp15.bkp:15:9: warning: + • The MINIMAL pragma does not require: + ‘xa’ and ‘y’ + but there is no default implementation. + • In the class declaration for ‘Bloop’ [2 of 5] Processing q [1 of 1] Compiling H[sig] ( q/H.hsig, nothing ) + +bkp15.bkp:40:9: warning: + • The MINIMAL pragma does not require: + ‘xa’ and ‘y’ + but there is no default implementation. + • In the class declaration for ‘Bloop’ [3 of 5] Processing r [1 of 2] Compiling H[sig] ( r/H.hsig, nothing ) [2 of 2] Compiling M ( r/M.hs, nothing ) [4 of 5] Processing h-impl Instantiating h-impl [1 of 1] Compiling H ( h-impl/H.hs, bkp15.out/h-impl/H.o ) + +bkp15.bkp:76:9: warning: + • The MINIMAL pragma does not require: + ‘xa’ and ‘y’ + but there is no default implementation. + • In the class declaration for ‘Bloop’ [5 of 5] Processing s Instantiating s [1 of 1] Including r[H=h-impl:H] diff --git a/testsuite/tests/backpack/should_compile/bkp25.bkp b/testsuite/tests/backpack/should_compile/bkp25.bkp index fb26323d54..672339fae0 100644 --- a/testsuite/tests/backpack/should_compile/bkp25.bkp +++ b/testsuite/tests/backpack/should_compile/bkp25.bkp @@ -1,7 +1,7 @@ unit p where - signature A(A) where + signature A where data A - signature B(A) where + signature B(module B, A) where import A module P where import A @@ -15,9 +15,9 @@ unit r where unit q where dependency p[A=<A>,B=<B>] dependency r - signature A(A) where + signature A(module A, A) where import Impl(A) - signature B(A) where + signature B(module B, A) where import Impl(A) module M where import A diff --git a/testsuite/tests/backpack/should_compile/bkp28.bkp b/testsuite/tests/backpack/should_compile/bkp28.bkp index d2e403ccaf..c6f0f4546f 100644 --- a/testsuite/tests/backpack/should_compile/bkp28.bkp +++ b/testsuite/tests/backpack/should_compile/bkp28.bkp @@ -3,7 +3,7 @@ unit i where data I = I unit p where dependency i - signature A(I,f,g) where + signature A(module A, I) where import I f :: I -> I g :: I diff --git a/testsuite/tests/backpack/should_compile/bkp43.bkp b/testsuite/tests/backpack/should_compile/bkp43.bkp new file mode 100644 index 0000000000..60a4990dd8 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp43.bkp @@ -0,0 +1,20 @@ +unit sig where + signature A where + x :: Int + y :: Int + +unit blub where + dependency signature sig[A=<A>] + signature A (x) where + x :: Int + module M (y) where + import A + y = x + +unit impl where + module A where + x :: Int + x = 2 + +unit all where + dependency blub[A=impl:A] diff --git a/testsuite/tests/backpack/should_compile/bkp43.stderr b/testsuite/tests/backpack/should_compile/bkp43.stderr new file mode 100644 index 0000000000..6915f14f1c --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp43.stderr @@ -0,0 +1,14 @@ +[1 of 4] Processing sig + [1 of 1] Compiling A[sig] ( sig/A.hsig, nothing ) +[2 of 4] Processing blub + [1 of 2] Compiling A[sig] ( blub/A.hsig, nothing ) + [2 of 2] Compiling M ( blub/M.hs, nothing ) +[3 of 4] Processing impl + Instantiating impl + [1 of 1] Compiling A ( impl/A.hs, bkp43.out/impl/A.o ) +[4 of 4] Processing all + Instantiating all + [1 of 1] Including blub[A=impl:A] + Instantiating blub[A=impl:A] + [1 of 2] Compiling A[sig] ( blub/A.hsig, bkp43.out/blub/blub-EMBMWyCjWt1EWXmIjSqmRG/A.o ) + [2 of 2] Compiling M ( blub/M.hs, bkp43.out/blub/blub-EMBMWyCjWt1EWXmIjSqmRG/M.o ) diff --git a/testsuite/tests/backpack/should_compile/bkp44.bkp b/testsuite/tests/backpack/should_compile/bkp44.bkp new file mode 100644 index 0000000000..06134b7086 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp44.bkp @@ -0,0 +1,23 @@ +unit p where + signature A where + data T + x :: Bool + signature B where + import A + y :: T + z :: Bool +unit q where + dependency signature p[A=<A>,B=<B>] + signature A (x) where + signature B (z) where + module M(y) where + import A + import B + y = x && z +unit pimpl where + module A where + x = True + module B where + z = False +unit r where + dependency q[A=pimpl:A,B=pimpl:B] diff --git a/testsuite/tests/backpack/should_compile/bkp44.stderr b/testsuite/tests/backpack/should_compile/bkp44.stderr new file mode 100644 index 0000000000..020dfa67ca --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp44.stderr @@ -0,0 +1,18 @@ +[1 of 4] Processing p + [1 of 2] Compiling A[sig] ( p/A.hsig, nothing ) + [2 of 2] Compiling B[sig] ( p/B.hsig, nothing ) +[2 of 4] Processing q + [1 of 3] Compiling A[sig] ( q/A.hsig, nothing ) + [2 of 3] Compiling B[sig] ( q/B.hsig, nothing ) + [3 of 3] Compiling M ( q/M.hs, nothing ) +[3 of 4] Processing pimpl + Instantiating pimpl + [1 of 2] Compiling A ( pimpl/A.hs, bkp44.out/pimpl/A.o ) + [2 of 2] Compiling B ( pimpl/B.hs, bkp44.out/pimpl/B.o ) +[4 of 4] Processing r + Instantiating r + [1 of 1] Including q[A=pimpl:A,B=pimpl:B] + Instantiating q[A=pimpl:A,B=pimpl:B] + [1 of 3] Compiling A[sig] ( q/A.hsig, bkp44.out/q/q-BxPafal3NcFHV8AOBzU3fg/A.o ) + [2 of 3] Compiling B[sig] ( q/B.hsig, bkp44.out/q/q-BxPafal3NcFHV8AOBzU3fg/B.o ) + [3 of 3] Compiling M ( q/M.hs, bkp44.out/q/q-BxPafal3NcFHV8AOBzU3fg/M.o ) diff --git a/testsuite/tests/backpack/should_fail/all.T b/testsuite/tests/backpack/should_fail/all.T index f29657a88a..f55248bab9 100644 --- a/testsuite/tests/backpack/should_fail/all.T +++ b/testsuite/tests/backpack/should_fail/all.T @@ -25,3 +25,10 @@ test('bkpfail26', normal, backpack_compile_fail, ['']) test('bkpfail27', normal, backpack_compile_fail, ['']) test('bkpfail28', normal, backpack_compile_fail, ['']) test('bkpfail29', normal, backpack_compile_fail, ['']) +test('bkpfail30', normal, backpack_compile_fail, ['']) +test('bkpfail31', normal, backpack_compile_fail, ['']) +test('bkpfail32', normal, backpack_compile_fail, ['']) +test('bkpfail33', normal, backpack_compile_fail, ['']) +test('bkpfail34', normal, backpack_compile_fail, ['']) +test('bkpfail35', normal, backpack_compile_fail, ['']) +test('bkpfail36', normal, backpack_compile_fail, ['']) diff --git a/testsuite/tests/backpack/should_fail/bkpfail03.bkp b/testsuite/tests/backpack/should_fail/bkpfail03.bkp index 70be6d088d..7c622c1d55 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail03.bkp +++ b/testsuite/tests/backpack/should_fail/bkpfail03.bkp @@ -1,7 +1,7 @@ unit q where module M1 where data M = M - signature M2(M) where + signature M2(module M2, M) where import M1 unit m2 where module M2 where diff --git a/testsuite/tests/backpack/should_fail/bkpfail05.bkp b/testsuite/tests/backpack/should_fail/bkpfail05.bkp index 2bf58a181e..afc484faef 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail05.bkp +++ b/testsuite/tests/backpack/should_fail/bkpfail05.bkp @@ -10,7 +10,7 @@ unit p where -- Known bug: GHC will not eagerly report an error here although -- it could, if it more aggressively checked for type-compatibility -- when a hole gets resolved - signature H(T(..)) where + signature H(module H, T(..)) where import T unit h-impl where dependency t-impl diff --git a/testsuite/tests/backpack/should_fail/bkpfail19.bkp b/testsuite/tests/backpack/should_fail/bkpfail19.bkp index 1752b7c074..9a3f2611a9 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail19.bkp +++ b/testsuite/tests/backpack/should_fail/bkpfail19.bkp @@ -1,5 +1,5 @@ unit p where - signature ShouldFail(newSTRef) where + signature ShouldFail(module ShouldFail, newSTRef) where import Data.STRef.Lazy(newSTRef) unit q where dependency p[ShouldFail=base:Data.STRef] diff --git a/testsuite/tests/backpack/should_fail/bkpfail20.bkp b/testsuite/tests/backpack/should_fail/bkpfail20.bkp index 18d497347b..9fc243ea23 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail20.bkp +++ b/testsuite/tests/backpack/should_fail/bkpfail20.bkp @@ -1,8 +1,8 @@ unit p where - signature A(newSTRef) where + signature A(module A, newSTRef) where import Data.STRef.Lazy(newSTRef) unit q where - signature A(newSTRef) where + signature A(module A, newSTRef) where import Data.STRef.Strict(newSTRef) unit r where dependency p[A=<B>] diff --git a/testsuite/tests/backpack/should_fail/bkpfail21.bkp b/testsuite/tests/backpack/should_fail/bkpfail21.bkp index 322fe5172c..cb0b9af5d1 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail21.bkp +++ b/testsuite/tests/backpack/should_fail/bkpfail21.bkp @@ -1,12 +1,12 @@ unit p where signature A where data T - signature C(T) where + signature C(module C, T) where import A unit q where signature B where data T - signature C(T) where + signature C(module C, T) where import B unit r where dependency p[A=<H1>,C=<H3>] diff --git a/testsuite/tests/backpack/should_fail/bkpfail29.stderr b/testsuite/tests/backpack/should_fail/bkpfail29.stderr index 8573d111d1..768365aba7 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail29.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail29.stderr @@ -7,5 +7,5 @@ bkpfail29.bkp:8:9: error: Cycle in type synonym declarations: - bkpfail29.bkp:8:9-18: {A.S} from external module - bkpfail29.bkp:7:9-14: {A.T} from external module + bkpfail29.bkp:8:9-18: S from external module + bkpfail29.bkp:7:9-14: T from external module diff --git a/testsuite/tests/backpack/should_fail/bkpfail30.bkp b/testsuite/tests/backpack/should_fail/bkpfail30.bkp new file mode 100644 index 0000000000..c7b0ca8116 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail30.bkp @@ -0,0 +1,9 @@ +unit p where + signature A(x) where + data T + x :: T +unit q where + module A where + x = True +unit r where + dependency p[A=q:A] diff --git a/testsuite/tests/backpack/should_fail/bkpfail30.stderr b/testsuite/tests/backpack/should_fail/bkpfail30.stderr new file mode 100644 index 0000000000..7d332560f6 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail30.stderr @@ -0,0 +1,6 @@ +[1 of 3] Processing p + [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) + +<no location info>: error: + The identifier T does not exist in the local signature. + (Try adding it to the export list of the hsig file.) diff --git a/testsuite/tests/backpack/should_fail/bkpfail31.bkp b/testsuite/tests/backpack/should_fail/bkpfail31.bkp new file mode 100644 index 0000000000..8815e5b438 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail31.bkp @@ -0,0 +1,16 @@ +unit p where + signature A where + data T + x :: T +unit q where + dependency signature p[A=<A>] + signature A (x) where + module M where + import A + y = x +unit pimpl where + module A where + -- type T = Bool + x = True +unit r where + dependency q[A=pimpl:A] diff --git a/testsuite/tests/backpack/should_fail/bkpfail31.stderr b/testsuite/tests/backpack/should_fail/bkpfail31.stderr new file mode 100644 index 0000000000..b5c9bc7b1f --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail31.stderr @@ -0,0 +1,8 @@ +[1 of 4] Processing p + [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) +[2 of 4] Processing q + [1 of 2] Compiling A[sig] ( q/A.hsig, nothing ) + +<no location info>: error: + The identifier T does not exist in the local signature. + (Try adding it to the export list of the hsig file.) diff --git a/testsuite/tests/backpack/should_fail/bkpfail32.bkp b/testsuite/tests/backpack/should_fail/bkpfail32.bkp new file mode 100644 index 0000000000..9d4f684906 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail32.bkp @@ -0,0 +1,2 @@ +unit p where + signature A (T) where diff --git a/testsuite/tests/backpack/should_fail/bkpfail32.stderr b/testsuite/tests/backpack/should_fail/bkpfail32.stderr new file mode 100644 index 0000000000..a33ea5bd42 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail32.stderr @@ -0,0 +1,5 @@ +[1 of 1] Processing p + [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) + +bkpfail32.bkp:2:18: error: + Not in scope: type constructor or class ‘T’ diff --git a/testsuite/tests/backpack/should_fail/bkpfail33.bkp b/testsuite/tests/backpack/should_fail/bkpfail33.bkp new file mode 100644 index 0000000000..4c76d81702 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail33.bkp @@ -0,0 +1,5 @@ +unit p where + signature A where +unit q where + dependency signature p[A=<A>] + signature A (T) where diff --git a/testsuite/tests/backpack/should_fail/bkpfail33.stderr b/testsuite/tests/backpack/should_fail/bkpfail33.stderr new file mode 100644 index 0000000000..fd268adb09 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail33.stderr @@ -0,0 +1,7 @@ +[1 of 2] Processing p + [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) +[2 of 2] Processing q + [1 of 1] Compiling A[sig] ( q/A.hsig, nothing ) + +bkpfail33.bkp:5:18: error: + Not in scope: type constructor or class ‘T’ diff --git a/testsuite/tests/backpack/should_fail/bkpfail34.bkp b/testsuite/tests/backpack/should_fail/bkpfail34.bkp new file mode 100644 index 0000000000..6ea000277f --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail34.bkp @@ -0,0 +1,7 @@ +unit p where + signature A where + data T + x :: T +unit q where + dependency signature p[A=<A>] + signature A (x) where diff --git a/testsuite/tests/backpack/should_fail/bkpfail34.stderr b/testsuite/tests/backpack/should_fail/bkpfail34.stderr new file mode 100644 index 0000000000..225e491406 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail34.stderr @@ -0,0 +1,8 @@ +[1 of 2] Processing p + [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) +[2 of 2] Processing q + [1 of 1] Compiling A[sig] ( q/A.hsig, nothing ) + +<no location info>: error: + The identifier T does not exist in the local signature. + (Try adding it to the export list of the hsig file.) diff --git a/testsuite/tests/backpack/should_fail/bkpfail35.bkp b/testsuite/tests/backpack/should_fail/bkpfail35.bkp new file mode 100644 index 0000000000..adfc14aa28 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail35.bkp @@ -0,0 +1,13 @@ +unit p where + signature A where + x :: Bool + y :: Bool + module B where +unit q where + dependency signature p[A=<A>] + signature A (x) where +unit aimpl where + module A where + x = True +unit r where + dependency q[A=aimpl:A] diff --git a/testsuite/tests/backpack/should_fail/bkpfail35.stderr b/testsuite/tests/backpack/should_fail/bkpfail35.stderr new file mode 100644 index 0000000000..f90d0e2bc6 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail35.stderr @@ -0,0 +1,16 @@ +[1 of 4] Processing p + [1 of 2] Compiling A[sig] ( p/A.hsig, nothing ) + [2 of 2] Compiling B ( p/B.hs, nothing ) +[2 of 4] Processing q + [1 of 1] Compiling A[sig] ( q/A.hsig, nothing ) +[3 of 4] Processing aimpl + Instantiating aimpl + [1 of 1] Compiling A ( aimpl/A.hs, bkpfail35.out/aimpl/A.o ) +[4 of 4] Processing r + Instantiating r + [1 of 1] Including q[A=aimpl:A] + Instantiating q[A=aimpl:A] + [1 of 1] Compiling A[sig] ( q/A.hsig, bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/A.o ) + +bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error: + ‘y’ is exported by the hsig file, but not exported the module ‘aimpl:A’ diff --git a/testsuite/tests/backpack/should_fail/bkpfail36.bkp b/testsuite/tests/backpack/should_fail/bkpfail36.bkp new file mode 100644 index 0000000000..15ec645271 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail36.bkp @@ -0,0 +1,10 @@ +unit p where + signature A where + data T + x :: Bool + signature B where + import A + y :: T +unit q where + dependency signature p[A=<A>,B=<B>] + signature A (x) where diff --git a/testsuite/tests/backpack/should_fail/bkpfail36.stderr b/testsuite/tests/backpack/should_fail/bkpfail36.stderr new file mode 100644 index 0000000000..cd65f67384 --- /dev/null +++ b/testsuite/tests/backpack/should_fail/bkpfail36.stderr @@ -0,0 +1,10 @@ +[1 of 2] Processing p + [1 of 2] Compiling A[sig] ( p/A.hsig, nothing ) + [2 of 2] Compiling B[sig] ( p/B.hsig, nothing ) +[2 of 2] Processing q + [1 of 2] Compiling A[sig] ( q/A.hsig, nothing ) + [2 of 2] Compiling B[sig] ( q/B.hsig, nothing ) + +<no location info>: error: + The identifier T does not exist in the signature for <A> + (Try adding it to the export list in that hsig file.) |