Fix #11754 by adding an additional check.

This was just plain wrong previously.

Test case: typecheck/should_compile/T11754

3 files changed, 33 insertions, 3 deletions

diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs
index fb6c68e303..e39f0aa046 100644
--- a/compiler/types/OptCoercion.hs
+++ b/compiler/types/OptCoercion.hs
@@ -874,10 +874,11 @@ etaTyConAppCo_maybe tc (TyConAppCo _ tc2 cos2)
 
 etaTyConAppCo_maybe tc co
   | mightBeUnsaturatedTyCon tc
-  , Pair ty1 ty2     <- coercionKind co
-  , Just (tc1, tys1) <- splitTyConApp_maybe ty1
-  , Just (tc2, tys2) <- splitTyConApp_maybe ty2
+  , (Pair ty1 ty2, r) <- coercionKindRole co
+  , Just (tc1, tys1)  <- splitTyConApp_maybe ty1
+  , Just (tc2, tys2)  <- splitTyConApp_maybe ty2
   , tc1 == tc2
+  , isInjectiveTyCon tc r  -- See Note [NthCo and newtypes] in TyCoRep
   , let n = length tys1
   = ASSERT( tc == tc1 )
     ASSERT( n == length tys2 )
diff --git a/testsuite/tests/typecheck/should_compile/T11754.hs b/testsuite/tests/typecheck/should_compile/T11754.hs
new file mode 100644
index 0000000000..248be2b04d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T11754.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE TypeOperators, UndecidableSuperClasses, KindSignatures,
+TypeFamilies, FlexibleContexts #-}
+
+module T11754 where
+
+import Data.Kind
+import Data.Void
+
+newtype K a x = K a
+newtype I   x = I x
+
+data (f + g) x = L (f x) | R (g x)
+data (f × g) x = f x :×: g x
+
+class Differentiable (D f) => Differentiable f where
+  type D (f :: Type -> Type) :: Type -> Type
+
+instance Differentiable (K a) where
+  type D (K a) = K Void
+
+instance Differentiable I where
+  type D I = K ()
+
+instance (Differentiable f₁, Differentiable f₂) => Differentiable (f₁ + f₂) where
+  type D (f₁ + f₂) = D f₁ + D f₂
+
+instance (Differentiable f₁, Differentiable f₂) => Differentiable (f₁ × f₂) where
+  type D (f₁ × f₂) = (D f₁ × f₂) + (f₁ × D f₂)
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 267795b544..0d99284d32 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -510,3 +510,4 @@ test('T11608', normal, compile, [''])
 test('T11401', normal, compile, [''])
 test('T11699', normal, compile, [''])
 test('T11512', normal, compile, [''])
+test('T11754', normal, compile, [''])