Fix #10816 by renaming FixitySigs more consistently

Summary:
#10816 surfaced because we were renaming top-level fixity
declarations with a different code path (`rnSrcFixityDecl`) than
the code path for fixity declarations inside of type classes, which
is not privy to names that exist in the type namespace. Luckily, the
fix is simple: use `rnSrcFixityDecl` in both places.

Test Plan: make test TEST=T10816

Reviewers: austin, bgamari, simonpj

Reviewed By: simonpj

Subscribers: simonpj, rwbarton, thomie

GHC Trac Issues: #10816

Differential Revision: https://phabricator.haskell.org/D4077

4 files changed, 50 insertions, 45 deletions

diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index bf3ee26ae7..02a37b20ef 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -21,7 +21,7 @@ module RnBinds (
 
    -- Other bindings
    rnMethodBinds, renameSigs,
-   rnMatchGroup, rnGRHSs, rnGRHS,
+   rnMatchGroup, rnGRHSs, rnGRHS, rnSrcFixityDecl,
    makeMiniFixityEnv, MiniFixityEnv,
    HsSigCtxt(..)
    ) where
@@ -941,7 +941,6 @@ renameSigs ctxt sigs
 -- Doesn't seem worth much trouble to sort this.
 
 renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars)
--- FixitySig is renamed elsewhere.
 renameSig _ (IdSig x)
   = return (IdSig x, emptyFVs)    -- Actually this never occurs
 
@@ -988,9 +987,9 @@ renameSig ctxt sig@(InlineSig v s)
   = do  { new_v <- lookupSigOccRn ctxt sig v
         ; return (InlineSig new_v s, emptyFVs) }
 
-renameSig ctxt sig@(FixSig (FixitySig vs f))
-  = do  { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
-        ; return (FixSig (FixitySig new_vs f), emptyFVs) }
+renameSig ctxt (FixSig fsig)
+  = do  { new_fsig <- rnSrcFixityDecl ctxt fsig
+        ; return (FixSig new_fsig, emptyFVs) }
 
 renameSig ctxt sig@(MinimalSig s (L l bf))
   = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf
@@ -1223,6 +1222,38 @@ rnGRHS' ctxt rnBody (GRHS guards rhs)
     is_standard_guard _                        = False
 
 {-
+*********************************************************
+*                                                       *
+        Source-code fixity declarations
+*                                                       *
+*********************************************************
+-}
+
+rnSrcFixityDecl :: HsSigCtxt -> FixitySig GhcPs -> RnM (FixitySig GhcRn)
+-- Rename a fixity decl, so we can put
+-- the renamed decl in the renamed syntax tree
+-- Errors if the thing being fixed is not defined locally.
+rnSrcFixityDecl sig_ctxt = rn_decl
+  where
+    rn_decl :: FixitySig GhcPs -> RnM (FixitySig GhcRn)
+        -- GHC extension: look up both the tycon and data con
+        -- for con-like things; hence returning a list
+        -- If neither are in scope, report an error; otherwise
+        -- return a fixity sig for each (slightly odd)
+    rn_decl (FixitySig fnames fixity)
+      = do names <- concatMapM lookup_one fnames
+           return (FixitySig names fixity)
+
+    lookup_one :: Located RdrName -> RnM [Located Name]
+    lookup_one (L name_loc rdr_name)
+      = setSrcSpan name_loc $
+                    -- This lookup will fail if the name is not defined in the
+                    -- same binding group as this fixity declaration.
+        do names <- lookupLocalTcNames sig_ctxt what rdr_name
+           return [ L name_loc name | (_, name) <- names ]
+    what = text "fixity signature"
+
+{-
 ************************************************************************
 *                                                                      *
 \subsection{Error messages}
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index b47686ebfa..b182382381 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -177,7 +177,8 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
    -- Rename fixity declarations and error if we try to
    -- fix something from another module (duplicates were checked in (A))
    let { all_bndrs = tc_bndrs `unionNameSet` val_bndr_set } ;
-   rn_fix_decls <- rnSrcFixityDecls all_bndrs fix_decls ;
+   rn_fix_decls <- mapM (mapM (rnSrcFixityDecl (TopSigCtxt all_bndrs)))
+                        fix_decls ;
 
    -- Rename deprec decls;
    -- check for duplicates and ensure that deprecated things are defined locally
@@ -266,45 +267,6 @@ rnDocDecl (DocGroup lev doc) = do
 {-
 *********************************************************
 *                                                       *
-        Source-code fixity declarations
-*                                                       *
-*********************************************************
--}
-
-rnSrcFixityDecls :: NameSet -> [LFixitySig GhcPs] -> RnM [LFixitySig GhcRn]
--- Rename the fixity decls, so we can put
--- the renamed decls in the renamed syntax tree
--- Errors if the thing being fixed is not defined locally.
---
--- The returned FixitySigs are not actually used for anything,
--- except perhaps the GHCi API
-rnSrcFixityDecls bndr_set fix_decls
-  = do fix_decls <- mapM rn_decl fix_decls
-       return (concat fix_decls)
-  where
-    sig_ctxt = TopSigCtxt bndr_set
-
-    rn_decl :: LFixitySig GhcPs -> RnM [LFixitySig GhcRn]
-        -- GHC extension: look up both the tycon and data con
-        -- for con-like things; hence returning a list
-        -- If neither are in scope, report an error; otherwise
-        -- return a fixity sig for each (slightly odd)
-    rn_decl (L loc (FixitySig fnames fixity))
-      = do names <- mapM lookup_one fnames
-           return [ L loc (FixitySig name fixity)
-                  | name <- names ]
-
-    lookup_one :: Located RdrName -> RnM [Located Name]
-    lookup_one (L name_loc rdr_name)
-      = setSrcSpan name_loc $
-                    -- this lookup will fail if the definition isn't local
-        do names <- lookupLocalTcNames sig_ctxt what rdr_name
-           return [ L name_loc name | (_, name) <- names ]
-    what = text "fixity signature"
-
-{-
-*********************************************************
-*                                                       *
         Source-code deprecations declarations
 *                                                       *
 *********************************************************
diff --git a/testsuite/tests/rename/should_compile/T10816.hs b/testsuite/tests/rename/should_compile/T10816.hs
new file mode 100644
index 0000000000..3f8cc604f0
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T10816.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TypeOperators, TypeFamilies #-}
+module T10816 where
+
+class C a where
+  type a # b
+  infix 4 #
+
+  type a *** b
+  type a +++ b
+  infixr 5 ***, +++
+  (***), (+++) :: a -> a -> a
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 0b46f90e17..4eb584febe 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -139,6 +139,7 @@ test('T7969', [], run_command, ['$MAKE -s --no-print-directory T7969'])
 test('T9127', normal, compile, [''])
 test('T4426', normal, compile_fail, [''])
 test('T9778', normal, compile, ['-fwarn-unticked-promoted-constructors'])
+test('T10816', normal, compile, [''])
 test('T11164', [], multimod_compile, ['T11164', '-v0'])
 test('T11167', normal, compile, [''])
 test('T11167_ambig', normal, compile, [''])