Rename role annotations w.r.t only local decls.

Fix #10263.

5 files changed, 34 insertions, 12 deletions

diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index d9d471ace3..0794412051 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -17,6 +17,7 @@ module RnEnv (
         reportUnboundName,
 
         HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
+        lookupSigCtxtOccRn,
 
         lookupFixityRn, lookupTyFixityRn,
         lookupInstDeclBndr, lookupSubBndrOcc, lookupFamInstName,
@@ -1064,13 +1065,22 @@ data HsSigCtxt
   | ClsDeclCtxt   Name       -- Class decl for this class
   | InstDeclCtxt  Name       -- Intsance decl for this class
   | HsBootCtxt               -- Top level of a hs-boot file
+  | RoleAnnotCtxt NameSet    -- A role annotation, with the names of all types
+                             -- in the group
 
 lookupSigOccRn :: HsSigCtxt
                -> Sig RdrName
                -> Located RdrName -> RnM (Located Name)
-lookupSigOccRn ctxt sig
+lookupSigOccRn ctxt sig = lookupSigCtxtOccRn ctxt (hsSigDoc sig)
+
+-- | Lookup a name in relation to the names in a 'HsSigCtxt'
+lookupSigCtxtOccRn :: HsSigCtxt
+                   -> SDoc         -- ^ description of thing we're looking up,
+                                   -- like "type family"
+                   -> Located RdrName -> RnM (Located Name)
+lookupSigCtxtOccRn ctxt what
   = wrapLocM $ \ rdr_name ->
-    do { mb_name <- lookupBindGroupOcc ctxt (hsSigDoc sig) rdr_name
+    do { mb_name <- lookupBindGroupOcc ctxt what rdr_name
        ; case mb_name of
            Left err   -> do { addErr err; return (mkUnboundName rdr_name) }
            Right name -> return name }
@@ -1098,6 +1108,7 @@ lookupBindGroupOcc ctxt what rdr_name
   = case ctxt of
       HsBootCtxt            -> lookup_top (const True)       True
       TopSigCtxt ns meth_ok -> lookup_top (`elemNameSet` ns) meth_ok
+      RoleAnnotCtxt ns      -> lookup_top (`elemNameSet` ns) False
       LocalBindCtxt ns      -> lookup_group ns
       ClsDeclCtxt  cls      -> lookup_cls_op cls
       InstDeclCtxt cls      -> lookup_cls_op cls
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 5b250c645f..a54aaf04f8 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -951,7 +951,8 @@ rnTyClDecls :: Maybe FreeVars -> [TyClGroup RdrName]
 -- Rename the declarations and do depedency analysis on them
 rnTyClDecls extra_deps tycl_ds
   = do { ds_w_fvs <- mapM (wrapLocFstM rnTyClDecl) (tyClGroupConcat tycl_ds)
-       ; role_annot_env <- rnRoleAnnots (concatMap group_roles tycl_ds)
+       ; let decl_names = mkNameSet (map (tcdName . unLoc . fst) ds_w_fvs)
+       ; role_annot_env <- rnRoleAnnots decl_names (concatMap group_roles tycl_ds)
        ; this_mod  <- getModule
        ; let add_boot_deps :: FreeVars -> FreeVars
              -- See Note [Extra dependencies from .hs-boot files]
@@ -1094,13 +1095,14 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
 rnTySyn :: HsDocContext -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
 rnTySyn doc rhs = rnLHsType doc rhs
 
--- Renames role annotations, returning them as the values in a NameEnv
+-- | Renames role annotations, returning them as the values in a NameEnv
 -- and checks for duplicate role annotations.
 -- It is quite convenient to do both of these in the same place.
 -- See also Note [Role annotations in the renamer]
-rnRoleAnnots :: [LRoleAnnotDecl RdrName]
-                -> RnM (NameEnv (LRoleAnnotDecl Name))
-rnRoleAnnots role_annots
+rnRoleAnnots :: NameSet  -- ^ of the decls in this group
+             -> [LRoleAnnotDecl RdrName]
+             -> RnM (NameEnv (LRoleAnnotDecl Name))
+rnRoleAnnots decl_names role_annots
   = do {  -- check for duplicates *before* renaming, to avoid lumping
           -- together all the unboundNames
          let (no_dups, dup_annots) = removeDups role_annots_cmp role_annots
@@ -1116,8 +1118,11 @@ rnRoleAnnots role_annots
                             , not (isUnboundName name) ] }
   where
     rn_role_annot1 (RoleAnnotDecl tycon roles)
-      = do {  -- the name is an *occurrence*
-             tycon' <- wrapLocM lookupGlobalOccRn tycon
+      = do {  -- the name is an *occurrence*, but look it up only in the
+              -- decls defined in this group (see #10263)
+             tycon' <- lookupSigCtxtOccRn (RoleAnnotCtxt decl_names)
+                                          (text "role annotation")
+                                          tycon
            ; return $ RoleAnnotDecl tycon' roles }
 
 dupRoleAnnotErr :: [LRoleAnnotDecl RdrName] -> RnM ()
diff --git a/testsuite/tests/ghci/scripts/T8485.stderr b/testsuite/tests/ghci/scripts/T8485.stderr
index 66358826c0..bbef720fe2 100644
--- a/testsuite/tests/ghci/scripts/T8485.stderr
+++ b/testsuite/tests/ghci/scripts/T8485.stderr
@@ -1,4 +1,4 @@
 
-<interactive>:3:1:
-    Role annotation for a type previously declared: type role X nominal
-    (The role annotation must be given where ‘X’ is declared.)
+<interactive>:3:11: error:
+    The role annotation for ‘X’ lacks an accompanying binding
+      (The role annotation must be given where ‘X’ is declared)
diff --git a/testsuite/tests/roles/should_compile/T10263.hs b/testsuite/tests/roles/should_compile/T10263.hs
new file mode 100644
index 0000000000..d12a3a4e80
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/T10263.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE RoleAnnotations #-}
+module T10263 where
+
+data Maybe a = AF
+type role Maybe representational
diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T
index 0bd779ff3b..2e0d8ea01c 100644
--- a/testsuite/tests/roles/should_compile/all.T
+++ b/testsuite/tests/roles/should_compile/all.T
@@ -5,3 +5,4 @@ test('Roles4', only_ways('normal'), compile, ['-ddump-tc'])
 test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques'])
 test('Roles14', only_ways('normal'), compile, ['-ddump-tc'])
 test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, ['-ddump-tc -dsuppress-uniques'])
+test('T10263', normal, compile, [''])