diff --git a/testsuite/tests/ghc-regress/indexed-types/should_fail/T2693.hs b/testsuite/tests/ghc-regress/indexed-types/should_fail/T2693.hs
new file mode 100644
index 0000000000000000000000000000000000000000..5b0066e948c83016354844c2b6bf3cee8f443603
--- /dev/null
+++ b/testsuite/tests/ghc-regress/indexed-types/should_fail/T2693.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T2693 where
+
+type family TFn a :: *
+
+f :: Maybe ()
+f = do
+  let Just x = undefined :: Maybe (TFn a)
+  let n = fst x + fst x
+  return ()
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_fail/T2693.stderr b/testsuite/tests/ghc-regress/indexed-types/should_fail/T2693.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..f66bd0bed2afca788c8c73ffbef99cd65a17b56f
--- /dev/null
+++ b/testsuite/tests/ghc-regress/indexed-types/should_fail/T2693.stderr
@@ -0,0 +1,7 @@
+
+T2693.hs:10:14:
+    Couldn't match expected type `(a1, b)'
+           against inferred type `TFn a'
+    In the first argument of `fst', namely `x'
+    In the first argument of `(+)', namely `fst x'
+    In the expression: fst x + fst x
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_fail/all.T b/testsuite/tests/ghc-regress/indexed-types/should_fail/all.T
index 61342c85eec7b3d24ee503525cd80ae5deebd82c..e9e0863d4abf2486d521a88ed74fb8f3e27ba15d 100644
--- a/testsuite/tests/ghc-regress/indexed-types/should_fail/all.T
+++ b/testsuite/tests/ghc-regress/indexed-types/should_fail/all.T
@@ -46,3 +46,4 @@ test('T1900', normal, compile_fail, [''])
 test('T2157', normal, compile_fail, [''])
 test('T2203a', normal, compile_fail, [''])
 test('T2627b', normal, compile_fail, [''])
+test('T2693', normal, compile_fail, [''])