diff --git a/compiler/GHC/Core/TyCo/Tidy.hs b/compiler/GHC/Core/TyCo/Tidy.hs
index c572f4a1e9dc7704de12649b795ea99323367a3e..bd1f2ed2ac837136ffed1a1aff3ec50c349df2ca 100644
--- a/compiler/GHC/Core/TyCo/Tidy.hs
+++ b/compiler/GHC/Core/TyCo/Tidy.hs
@@ -288,7 +288,7 @@ trimTidyEnv (occ_env, var_env) tcvs
 -- | Grabs the free type variables, tidies them
 -- and then uses 'tidyType' to work over the type itself
 tidyOpenTypesX :: TidyEnv -> [Type] -> (TidyEnv, [Type])
--- See Note [Tidying open  types]
+-- See Note [Tidying open types]
 tidyOpenTypesX env tys
   = (env1, tidyTypes inner_env tys)
   where
@@ -299,7 +299,7 @@ tidyOpenTypesX env tys
 
 ---------------
 tidyOpenTypeX :: TidyEnv -> Type -> (TidyEnv, Type)
--- See Note [Tidying open  types]
+-- See Note [Tidying open types]
 tidyOpenTypeX env ty
   = (env1, tidyType inner_env ty)
   where
diff --git a/compiler/GHC/Tc/Zonk/TcType.hs b/compiler/GHC/Tc/Zonk/TcType.hs
index cd932c8441ec1321f117292bfd1e312d18fb4d09..42aba8fd9018a2460412c46780053be1f441aa3f 100644
--- a/compiler/GHC/Tc/Zonk/TcType.hs
+++ b/compiler/GHC/Tc/Zonk/TcType.hs
@@ -658,13 +658,17 @@ tidyCtEvidence :: TidyEnv -> CtEvidence -> CtEvidence
      -- NB: we do not tidy the ctev_evar field because we don't
      --     show it in error messages
 tidyCtEvidence env ctev
-  = ctev { ctev_pred = tidyType env $ ctev_pred ctev }
-  -- No need for tidyOpenType because all the free tyvars are already tidied
+  = ctev { ctev_pred = tidyOpenType env $ ctev_pred ctev }
+  -- tidyOpenType: for (beta ~ (forall a. a->a), don't gratuitously
+  -- rename the 'forall a' just because of an 'a' in scope somewhere
+  -- else entirely.
 
 tidyHole :: TidyEnv -> Hole -> Hole
 tidyHole env h@(Hole { hole_ty = ty })
-  = h { hole_ty = tidyType env ty }
-  -- No need for tidyOpenType because all the free tyvars are already tidied
+  = h { hole_ty = tidyOpenType env ty }
+  -- tidyOpenType: for, say, (b -> (forall a. a->a)), don't gratuitously
+  -- rename the 'forall a' just because of an 'a' in scope somewhere
+  -- else entirely.
 
 tidyDelayedError :: TidyEnv -> DelayedError -> DelayedError
 tidyDelayedError env (DE_Hole hole)       = DE_Hole        $ tidyHole env hole
diff --git a/testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr b/testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr
index 8c08d4afad54aeacff318164c446d58d3b26e109..6ac93f374e51feb61ab70097fe27c54ba10c3b58 100644
--- a/testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr
+++ b/testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr
@@ -1,16 +1,16 @@
 GivenForallLoop.hs:8:11: error: [GHC-25897]
     • Could not deduce ‘a ~ b’
-      from the context: a ~ (forall b. F a b)
+      from the context: a ~ (forall b1. F a b1)
         bound by the type signature for:
-                   loopy :: forall a b. (a ~ (forall b. F a b)) => a -> b
+                   loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b
         at GivenForallLoop.hs:7:1-42
       ‘a’ is a rigid type variable bound by
         the type signature for:
-          loopy :: forall a b. (a ~ (forall b. F a b)) => a -> b
+          loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b
         at GivenForallLoop.hs:7:1-42
       ‘b’ is a rigid type variable bound by
         the type signature for:
-          loopy :: forall a b. (a ~ (forall b. F a b)) => a -> b
+          loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b
         at GivenForallLoop.hs:7:1-42
     • In the expression: x
       In an equation for ‘loopy’: loopy x = x