Improve the error messages for static forms.

Now the message explains why closed variables are not closed when
encountered in the body of (static ...).

This required adding to the local environment the free variables of
the local bindings in scope. Thus we can analyze and explain why a
variable is not closed when encountered.

Test Plan: ./validate

Reviewers: austin, simonpj, bgamari

Reviewed By: bgamari

Subscribers: mboes, thomie

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

GHC Trac Issues: #12003

9 files changed, 288 insertions, 64 deletions

diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index b34ad0bcad..8cfd5551ca 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -16,7 +16,7 @@ module TcBinds ( tcLocalBinds, tcTopBinds, tcRecSelBinds,
                  TcPragEnv, mkPragEnv,
                  tcUserTypeSig, instTcTySig, chooseInferredQuantifiers,
                  instTcTySigFromId, tcExtendTyVarEnvFromSig,
-                 badBootDeclErr ) where
+                 badBootDeclErr) where
 
 import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun )
 import {-# SOURCE #-} TcExpr  ( tcMonoExpr )
@@ -407,7 +407,7 @@ tcBindGroups top_lvl sig_fn prag_fn (group : groups) thing_inside
 ------------------------
 tc_group :: forall thing.
             TopLevelFlag -> TcSigFun -> TcPragEnv
-         -> (RecFlag, LHsBinds Name) -> TopLevelFlag -> TcM thing
+         -> (RecFlag, LHsBinds Name) -> IsGroupClosed -> TcM thing
          -> TcM ([(RecFlag, LHsBinds TcId)], thing)
 
 -- Typecheck one strongly-connected component of the original program.
@@ -470,7 +470,7 @@ recursivePatSynErr binds
 
 tc_single :: forall thing.
             TopLevelFlag -> TcSigFun -> TcPragEnv
-          -> LHsBind Name -> TopLevelFlag -> TcM thing
+          -> LHsBind Name -> IsGroupClosed -> TcM thing
           -> TcM (LHsBinds TcId, thing)
 tc_single _top_lvl sig_fn _prag_fn
           (L _ (PatSynBind psb@PSB{ psb_id = L _ name }))
@@ -522,7 +522,7 @@ tcPolyBinds :: TopLevelFlag -> TcSigFun -> TcPragEnv
             -> RecFlag         -- Whether the group is really recursive
             -> RecFlag         -- Whether it's recursive after breaking
                                -- dependencies based on type signatures
-            -> TopLevelFlag    -- Whether the group is closed
+            -> IsGroupClosed   -- Whether the group is closed
             -> [LHsBind Name]  -- None are PatSynBind
             -> TcM (LHsBinds TcId, [TcId])
 
@@ -1913,12 +1913,12 @@ instance Outputable GeneralisationPlan where
   ppr (CheckGen _ s) = text "CheckGen" <+> ppr s
 
 decideGeneralisationPlan
-   :: DynFlags -> [LHsBind Name] -> TopLevelFlag -> TcSigFun
+   :: DynFlags -> [LHsBind Name] -> IsGroupClosed -> TcSigFun
    -> GeneralisationPlan
 decideGeneralisationPlan dflags lbinds closed sig_fn
   | unlifted_pat_binds                    = NoGen
   | Just bind_sig <- one_funbind_with_sig = sig_plan bind_sig
-  | mono_local_binds                      = NoGen
+  | mono_local_binds closed               = NoGen
   | otherwise                             = InferGen mono_restriction
   where
     binds = map unLoc lbinds
@@ -1946,8 +1946,8 @@ decideGeneralisationPlan dflags lbinds closed sig_fn
     mono_restriction  = xopt LangExt.MonomorphismRestriction dflags
                      && any restricted binds
 
-    mono_local_binds = xopt LangExt.MonoLocalBinds dflags
-                    && not (isTopLevel closed)
+    mono_local_binds ClosedGroup = False
+    mono_local_binds _           = xopt LangExt.MonoLocalBinds dflags
 
     no_sig n = noCompleteSig (sig_fn n)
 
@@ -1974,17 +1974,23 @@ decideGeneralisationPlan dflags lbinds closed sig_fn
         -- No args => like a pattern binding
         -- Some args => a function binding
 
-isClosedBndrGroup :: Bag (LHsBind Name) -> TcM TopLevelFlag
+isClosedBndrGroup :: Bag (LHsBind Name) -> TcM IsGroupClosed
 isClosedBndrGroup binds = do
     type_env <- getLclTypeEnv
-    if foldrBag (is_closed_ns type_env . fvs . unLoc) True binds
-      then return TopLevel
-      else return NotTopLevel
+    if foldUFM (is_closed_ns type_env) True fv_env
+      then return ClosedGroup
+      else return $ NonClosedGroup fv_env
   where
-    fvs :: HsBind Name  -> NameSet
-    fvs (FunBind { bind_fvs = vs }) = vs
-    fvs (PatBind { bind_fvs = vs }) = vs
-    fvs _                           = emptyNameSet
+    fv_env :: NameEnv NameSet
+    fv_env = mkNameEnv $ concatMap (bindFvs . unLoc) binds
+
+    bindFvs :: HsBindLR Name idR -> [(Name, NameSet)]
+    bindFvs (FunBind { fun_id = f, bind_fvs = fvs })
+       = [(unLoc f, fvs)]
+    bindFvs (PatBind { pat_lhs = pat, bind_fvs = fvs })
+       = [(b, fvs) | b <- collectPatBinders pat]
+    bindFvs _
+       = []
 
     is_closed_ns :: TcTypeEnv -> NameSet -> Bool -> Bool
     is_closed_ns type_env ns b = b && nameSetAll (is_closed_id type_env) ns
@@ -1995,10 +2001,11 @@ isClosedBndrGroup binds = do
     is_closed_id type_env name
       | Just thing <- lookupNameEnv type_env name
       = case thing of
-          ATcId { tct_closed = cl } -> isTopLevel cl  -- This is the key line
-          ATyVar {}                 -> False          -- In-scope type variables
-          AGlobal {}                -> True           --    are not closed!
-          _                         -> pprPanic "is_closed_id" (ppr name)
+          ATcId { tct_info = ClosedLet } -> True  -- This is the key line
+          ATcId {}                       -> False
+          ATyVar {}                      -> False -- In-scope type variables
+          AGlobal {}                     -> True  --    are not closed!
+          _                              -> pprPanic "is_closed_id" (ppr name)
       | otherwise
       = True
         -- The free-var set for a top level binding mentions
diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs
index 42a03142c1..525e834393 100644
--- a/compiler/typecheck/TcEnv.hs
+++ b/compiler/typecheck/TcEnv.hs
@@ -407,40 +407,45 @@ tcExtendTyVarEnv2 binds thing_inside
                   tyvar' = setTyVarName tyvar name'
                   name'  = tidyNameOcc name occ'
 
-isTypeClosedLetBndr :: Id -> TopLevelFlag
+isTypeClosedLetBndr :: Id -> Bool
 -- See Note [Bindings with closed types] in TcRnTypes
--- Note that we decided if a let-bound variable is closed by
--- looking at its type, which is slightly more liberal, and a whole
--- lot easier to implement, than looking at its free variables
 isTypeClosedLetBndr id
-  | isEmptyVarSet (tyCoVarsOfType (idType id)) = TopLevel
-  | otherwise                                  = NotTopLevel
+  | isEmptyVarSet (tyCoVarsOfType (idType id)) = True
+  | otherwise                                  = False
 
-tcExtendLetEnv :: TopLevelFlag -> TopLevelFlag -> [TcId] -> TcM a -> TcM a
+tcExtendLetEnv :: TopLevelFlag -> IsGroupClosed -> [TcId] -> TcM a -> TcM a
 -- Used for both top-level value bindings and and nested let/where-bindings
 -- Adds to the TcIdBinderStack too
 tcExtendLetEnv top_lvl closed_group ids thing_inside
   = tcExtendIdBndrs [TcIdBndr id top_lvl | id <- ids] $
-    tcExtendLetEnvIds' top_lvl closed_group [(idName id, id) | id <- ids]
+    tcExtendLetEnvIds' top_lvl closed_group
+                       [(idName id, id) | id <- ids]
                        thing_inside
 
-tcExtendLetEnvIds :: TopLevelFlag -> [(Name,TcId)] -> TcM a -> TcM a
+tcExtendLetEnvIds :: TopLevelFlag -> [(Name, TcId)] -> TcM a -> TcM a
 -- Used for both top-level value bindings and and nested let/where-bindings
 -- Does not extend the TcIdBinderStack
 tcExtendLetEnvIds top_lvl
-  = tcExtendLetEnvIds' top_lvl TopLevel
+  = tcExtendLetEnvIds' top_lvl ClosedGroup
 
-tcExtendLetEnvIds' :: TopLevelFlag -> TopLevelFlag -> [(Name,TcId)] -> TcM a
+tcExtendLetEnvIds' :: TopLevelFlag -> IsGroupClosed
+                   -> [(Name,TcId)] -> TcM a
                    -> TcM a
 -- Used for both top-level value bindings and and nested let/where-bindings
 -- Does not extend the TcIdBinderStack
 tcExtendLetEnvIds' top_lvl closed_group pairs thing_inside
   = tc_extend_local_env top_lvl
-      [ (name, ATcId { tct_id = id
-                     , tct_closed = case closed_group of
-                         TopLevel -> isTypeClosedLetBndr id
-                         _        -> closed_group           })
-                     | (name,id) <- pairs ] $
+      [ (name, ATcId { tct_id = let_id
+                     , tct_info = case closed_group of
+                         ClosedGroup
+                           | isTypeClosedLetBndr let_id -> ClosedLet
+                           | otherwise -> NonClosedLet emptyNameSet False
+                         NonClosedGroup fvs ->
+                           NonClosedLet
+                             (maybe emptyNameSet id $ lookupNameEnv fvs name)
+                             (isTypeClosedLetBndr let_id)
+                     })
+      | (name, let_id) <- pairs ] $
     thing_inside
 
 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
@@ -460,7 +465,7 @@ tcExtendIdEnv2 names_w_ids thing_inside
                     | (_,mono_id) <- names_w_ids ] $
     do  { tc_extend_local_env NotTopLevel
                               [ (name, ATcId { tct_id = id
-                                             , tct_closed = NotTopLevel })
+                                             , tct_info = NotLetBound })
                               | (name,id) <- names_w_ids] $
           thing_inside }
 
@@ -512,11 +517,12 @@ tcExtendLocalTypeEnv lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) tc_ty_things
   where
     extra_tvs = foldr get_tvs emptyVarSet tc_ty_things
 
-    get_tvs (_, ATcId { tct_id = id, tct_closed = closed }) tvs
+    get_tvs (_, ATcId { tct_id = id, tct_info = closed }) tvs
       = case closed of
-          TopLevel    -> ASSERT2( isEmptyVarSet id_tvs, ppr id $$ ppr (idType id) )
-                         tvs
-          NotTopLevel -> tvs `unionVarSet` id_tvs
+          ClosedLet ->
+            ASSERT2( isEmptyVarSet id_tvs, ppr id $$ ppr (idType id) ) tvs
+          _           ->
+            tvs `unionVarSet` id_tvs
         where id_tvs = tyCoVarsOfType (idType id)
 
     get_tvs (_, ATyVar _ tv) tvs          -- See Note [Global TyVars]
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 5089cab80a..25a62cb7b3 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -49,6 +49,8 @@ import ConLike
 import DataCon
 import PatSyn
 import Name
+import NameEnv
+import NameSet
 import RdrName
 import TyCon
 import Type
@@ -2499,11 +2501,152 @@ fieldNotInType p rdr
 ************************************************************************
 -}
 
+-- | A data type to describe why a variable is not closed.
+data NotClosedReason = NotLetBoundReason
+                     | NotTypeClosed VarSet
+                     | NotClosed Name NotClosedReason
+
+-- | Checks if the given name is closed and emits an error if not.
+--
+-- See Note [Not-closed error messages].
 checkClosedInStaticForm :: Name -> TcM ()
 checkClosedInStaticForm name = do
-    thing <- tcLookup name
-    case thing of
-      ATcId { tct_closed = NotTopLevel } ->
-         addErrTc $ quotes (ppr name) <+>
-                    text "is used in a static form but it is not closed."
-      _ -> return ()
+    type_env <- getLclTypeEnv
+    case checkClosed type_env name of
+      Nothing -> return ()
+      Just reason -> addErrTc $ explain name reason
+  where
+    -- See Note [Checking closedness].
+    checkClosed :: TcTypeEnv -> Name -> Maybe NotClosedReason
+    checkClosed type_env n = checkLoop type_env (unitNameSet n) n
+
+    checkLoop :: TcTypeEnv -> NameSet -> Name -> Maybe NotClosedReason
+    checkLoop type_env visited n = do
+      -- The @visited@ set is an accumulating parameter that contains the set of
+      -- visited nodes, so we avoid repeating cycles in the traversal.
+      case lookupNameEnv type_env n of
+        Just (ATcId { tct_id = tcid, tct_info = info }) -> case info of
+          ClosedLet   -> Nothing
+          NotLetBound -> Just NotLetBoundReason
+          NonClosedLet fvs type_closed -> listToMaybe $
+            -- Look for a non-closed variable in fvs
+            [ NotClosed n' reason
+            | n' <- nameSetElemsStable fvs
+            , not (elemNameSet n' visited)
+            , Just reason <- [checkLoop type_env (extendNameSet visited n') n']
+            ] ++
+            if type_closed then
+              []
+            else
+              -- We consider non-let-bound variables easier to figure out than
+              -- non-closed types, so we report non-closed types to the user
+              -- only if we cannot spot the former.
+              [ NotTypeClosed $ tyCoVarsOfType (idType tcid) ]
+        -- The binding is closed.
+        _ -> Nothing
+
+    -- Converts a reason into a human-readable sentence.
+    --
+    -- @explain name reason@ starts with
+    --
+    -- "<name> is used in a static form but it is not closed because it"
+    --
+    -- and then follows a list of causes. For each id in the path, the text
+    --
+    -- "uses <id> which"
+    --
+    -- is appended, yielding something like
+    --
+    -- "uses <id> which uses <id1> which uses <id2> which"
+    --
+    -- until the end of the path is reached, which is reported as either
+    --
+    -- "is not let-bound"
+    --
+    -- when the final node is not let-bound, or
+    --
+    -- "has a non-closed type because it contains the type variables:
+    -- v1, v2, v3"
+    --
+    -- when the final node has a non-closed type.
+    --
+    explain :: Name -> NotClosedReason -> SDoc
+    explain name reason =
+      quotes (ppr name) <+> text "is used in a static form but it is not closed"
+                        <+> text "because it"
+                        $$
+                        sep (causes reason)
+
+    causes :: NotClosedReason -> [SDoc]
+    causes NotLetBoundReason = [text "is not let-bound."]
+    causes (NotTypeClosed vs) =
+      [ text "has a non-closed type because it contains the"
+      , text "type variables:" <+>
+        pprVarSet vs (hsep . punctuate comma . map (quotes . ppr))
+      ]
+    causes (NotClosed n reason) =
+      let msg = text "uses" <+> quotes (ppr n) <+> text "which"
+       in case reason of
+            NotClosed _ _ -> msg : causes reason
+            _   -> let (xs0, xs1) = splitAt 1 $ causes reason
+                    in fmap (msg <+>) xs0 ++ xs1
+
+-- Note [Not-closed error messages]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- When variables in a static form are not closed, we go through the trouble
+-- of explaining why they aren't.
+--
+-- Thus, the following program
+--
+-- > {-# LANGUAGE StaticPointers #-}
+-- > module M where
+-- >
+-- > f x = static g
+-- >   where
+-- >     g = h
+-- >     h = x
+--
+-- produces the error
+--
+--    'g' is used in a static form but it is not closed because it
+--    uses 'h' which uses 'x' which is not let-bound.
+--
+-- And a program like
+--
+-- > {-# LANGUAGE StaticPointers #-}
+-- > module M where
+-- >
+-- > import Data.Typeable
+-- > import GHC.StaticPtr
+-- >
+-- > f :: Typeable a => a -> StaticPtr TypeRep
+-- > f x = const (static (g undefined)) (h x)
+-- >   where
+-- >     g = h
+-- >     h = typeOf
+--
+-- produces the error
+--
+--    'g' is used in a static form but it is not closed because it
+--    uses 'h' which has a non-closed type because it contains the
+--    type variables: 'a'
+--
+
+-- Note [Checking closedness]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- @checkClosed@ checks if a binding is closed and returns a reason if it is
+-- not.
+--
+-- The bindings define a graph where the nodes are ids, and there is an edge
+-- from @id1@ to @id2@ if the rhs of @id1@ contains @id2@ among its free
+-- variables.
+--
+-- When @n@ is not closed, it has to exist in the graph some node reachable
+-- from @n@ that it is not a let-bound variable or that it has a non-closed
+-- type. Thus, the "reason" is a path from @n@ to this offending node.
+--
+-- When @n@ is not closed, we traverse the graph reachable from @n@ to build
+-- the reason.
+--
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index c6865f5492..154b127371 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1639,8 +1639,9 @@ runTcInteractive hsc_env thing_inside
     -- See Note [Initialising the type environment for GHCi]
     is_closed thing
       | AnId id <- thing
-      , NotTopLevel <- isTypeClosedLetBndr id
-      = Left (idName id, ATcId { tct_id = id, tct_closed = NotTopLevel })
+      , not (isTypeClosedLetBndr id)
+      = Left (idName id, ATcId { tct_id = id
+                               , tct_info = NotLetBound })
       | otherwise
       = Right thing
 
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index ef6feafc94..3978302958 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -40,6 +40,8 @@ module TcRnTypes(
         -- Typechecker types
         TcTypeEnv, TcIdBinderStack, TcIdBinder(..),
         TcTyThing(..), PromotionErr(..),
+        IdBindingInfo(..),
+        IsGroupClosed(..),
         SelfBootInfo(..),
         pprTcTyThingCategory, pprPECategory,
 
@@ -885,7 +887,7 @@ data TcTyThing
 
   | ATcId   {           -- Ids defined in this module; may not be fully zonked
         tct_id     :: TcId,
-        tct_closed :: TopLevelFlag }   -- See Note [Bindings with closed types]
+        tct_info :: IdBindingInfo }   -- See Note [Bindings with closed types]
 
   | ATyVar  Name TcTyVar        -- The type variable to which the lexically scoped type
                                 -- variable is bound. We only need the Name
@@ -922,11 +924,51 @@ instance Outputable TcTyThing where     -- Debugging only
    ppr elt@(ATcId {})   = text "Identifier" <>
                           brackets (ppr (tct_id elt) <> dcolon
                                  <> ppr (varType (tct_id elt)) <> comma
-                                 <+> ppr (tct_closed elt))
+                                 <+> ppr (tct_info elt))
    ppr (ATyVar n tv)    = text "Type variable" <+> quotes (ppr n) <+> equals <+> ppr tv
    ppr (ATcTyCon tc)    = text "ATcTyCon" <+> ppr tc
    ppr (APromotionErr err) = text "APromotionErr" <+> ppr err
 
+-- | Describes how an Id is bound.
+--
+-- It is used for the following purposes:
+--
+-- a) for static forms in TcExpr.checkClosedInStaticForm and
+-- b) to figure out when a nested binding can be generalised (in
+--    TcBinds.decideGeneralisationPlan).
+--
+-- See Note [Meaning of IdBindingInfo].
+data IdBindingInfo
+    = NotLetBound
+    | ClosedLet
+    | NonClosedLet NameSet Bool
+
+-- Note [Meaning of IdBindingInfo]
+--
+-- @NotLetBound@ means that the Id is not let-bound (e.g. it is bound in a
+-- lambda-abstraction or in a case pattern).
+--
+-- @ClosedLet@ means that the Id is let-bound, it is closed and its type is
+-- closed as well.
+--
+-- @NonClosedLet fvs type-closed@ means that the Id is let-bound but it is not
+-- closed. The @fvs@ set contains the free variables of the rhs. The type-closed
+-- flag indicates if the type of Id is closed.
+
+instance Outputable IdBindingInfo where
+  ppr NotLetBound = text "NotLetBound"
+  ppr ClosedLet = text "TopLevelLet"
+  ppr (NonClosedLet fvs closed_type) =
+    text "TopLevelLet" <+> ppr fvs <+> ppr closed_type
+
+-- | Tells if a group of binders is closed.
+--
+-- When it is not closed, it provides a map of binder ids to the free vars
+-- in their right-hand sides.
+--
+data IsGroupClosed = ClosedGroup
+                   | NonClosedGroup (NameEnv NameSet)
+
 instance Outputable PromotionErr where
   ppr ClassPE        = text "ClassPE"
   ppr TyConPE        = text "TyConPE"
@@ -969,7 +1011,7 @@ have no free type variables, and it is the type variables in the
 environment that makes things tricky for OutsideIn generalisation.
 
 Definition:
-   A variable is "closed", and has tct_closed set to TopLevel,
+   A variable is "closed", and has tct_info set to TopLevel,
 iff
    a) all its free variables are imported, or are let-bound and closed
    b) generalisation is not restricted by the monomorphism restriction
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
index 0590eaa567..52adc5b55b 100644
--- a/testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
@@ -1,5 +1,6 @@
 
 RnStaticPointersFail01.hs:5:7:
-    ‘x’  is used in a static form but it is not closed.
+    ‘x’  is used in a static form but it is not closed because it
+    is not let-bound.
     In the expression: static x
     In an equation for ‘f’: f x = static x
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail03.hs b/testsuite/tests/rename/should_fail/RnStaticPointersFail03.hs
index 141aa89e2a..882af36292 100644
--- a/testsuite/tests/rename/should_fail/RnStaticPointersFail03.hs
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail03.hs
@@ -2,6 +2,9 @@
 
 module RnStaticPointersFail03 where
 
+import Data.Typeable
+import GHC.StaticPtr
+
 f x = static (x . id)
 
 f0 x = static (k . id)
@@ -11,3 +14,9 @@ f0 x = static (k . id)
 f1 x = static (k . id)
   where
     k = id
+
+f2 :: Typeable a => a -> StaticPtr TypeRep
+f2 x = const (static (g undefined)) (h x)
+  where
+    g = h
+    h = typeOf
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
index 8102662257..3ba18c6869 100644
--- a/testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
@@ -1,14 +1,29 @@
 
-RnStaticPointersFail03.hs:5:7:
-    ‘x’ is used in a static form but it is not closed.
+RnStaticPointersFail03.hs:8:7:
+    ‘x’ is used in a static form but it is not closed because it
+    is not let-bound.
     In the expression: static (x . id)
     In an equation for ‘f’: f x = static (x . id)
 
-RnStaticPointersFail03.hs:7:8:
-     ‘k’ is used in a static form but it is not closed.
-     In the expression: static (k . id)
-     In an equation for ‘f0’:
-          f0 x
-            = static (k . id)
-            where
-                k = const (const () x)
+RnStaticPointersFail03.hs:10:8:
+    ‘k’ is used in a static form but it is not closed because it
+    uses ‘x’ which is not let-bound.
+    In the expression: static (k . id)
+    In an equation for ‘f0’:
+         f0 x
+           = static (k . id)
+           where
+               k = const (const () x)
+
+RnStaticPointersFail03.hs:19:15:
+    ‘g’ is used in a static form but it is not closed because it
+    uses ‘h’ which has a non-closed type because it contains the
+    type variables: ‘a’
+    In the first argument of ‘const’, namely ‘(static (g undefined))’
+    In the expression: const (static (g undefined)) (h x)
+    In an equation for ‘f2’:
+        f2 x
+          = const (static (g undefined)) (h x)
+          where
+              g = h
+              h = typeOf
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index 38106209c3..78b80e8220 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -115,7 +115,7 @@ test('T8448', normal, compile_fail, [''])
 test('T8149', normal, compile, [''])
 test('RnStaticPointersFail01', [], compile_fail, [''])
 test('RnStaticPointersFail02', [], compile_fail, [''])
-test('RnStaticPointersFail03', [], compile_fail, [''])
+test('RnStaticPointersFail03', [], compile_fail, ['-dsuppress-uniques'])
 test('T9006',
      extra_clean(['T9006a.hi', 'T9006a.o']),
      multimod_compile_fail, ['T9006', '-v0'])