diff --git a/testsuite/tests/typecheck/should_compile/T23192.hs b/testsuite/tests/typecheck/should_compile/T23192.hs
new file mode 100644
index 0000000000000000000000000000000000000000..be7ddf133daa555a131163a7417460dd1f16ed8d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T23192.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Werror=redundant-constraints #-}
+
+module EventThing where
+
+class Monad m => Event m where
+  thingsForEvent :: m [Int]
+
+class Monad m => Thingy m where
+  thingies :: m [Int]
+
+-- Check that we don't get a redundant constraint warning for "Monad m".
+-- See #19690.
+instance (Monad m, Event m) => Thingy m where
+  thingies = thingsForEvent
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 4c200961f4f2e44c5d5e24bad794c3ed1abb8777..b2232d8f6ede6600ceaade388ffc28519b3ac533 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -870,3 +870,4 @@ test('T21443', normal, compile, [''])
 test('QualifiedRecordUpdate',
     [ extra_files(['QualifiedRecordUpdate_aux.hs']) ]
     , multimod_compile, ['QualifiedRecordUpdate', '-v0'])
+test('T23192', normal, compile, [''])