diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 119c5c6c84840c8030b8d5750866ad953f202445..c71841a09d8086e93bc6de5c2cf8da534502b1ab 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -779,11 +779,22 @@ checkTyClHdr is_cls ty
       = parseErrorSDoc l (text "Malformed head of type or class declaration:"
                           <+> ppr ty)
 
+-- | Validate the context constraints and break up a context into a list
+-- of predicates.
+--
+-- @
+--     (Eq a, Ord b)        -->  [Eq a, Ord b]
+--     Eq a                 -->  [Eq a]
+--     (Eq a)               -->  [Eq a]
+--     (((Eq a)))           -->  [Eq a]
+-- @
 checkContext :: LHsType GhcPs -> P ([AddAnn],LHsContext GhcPs)
 checkContext (L l orig_t)
   = check [] (L l orig_t)
  where
-  check anns (L lp (HsTupleTy _ ts))   -- (Eq a, Ord b) shows up as a tuple type
+  check anns (L lp (HsTupleTy HsBoxedOrConstraintTuple ts))
+    -- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can
+    -- be used as context constraints.
     = return (anns ++ mkParensApiAnn lp,L l ts)                -- Ditto ()
 
     -- don't let HsAppsTy get in the way
diff --git a/testsuite/tests/parser/should_fail/T14740.hs b/testsuite/tests/parser/should_fail/T14740.hs
new file mode 100644
index 0000000000000000000000000000000000000000..b56687f05192a485c9d0fef9dc31b35e548e2812
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T14740.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE UnboxedTuples #-}
+
+module T14740 where
+
+x :: ((##)) => ()
+x = ()
diff --git a/testsuite/tests/parser/should_fail/T14740.stderr b/testsuite/tests/parser/should_fail/T14740.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..8827873e25ef6db0cda41f42f813fd1ad5d2ab4a
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T14740.stderr
@@ -0,0 +1,4 @@
+
+T14740.hs:5:7:
+     Expecting a lifted type, but ‘(# #)’ is unlifted
+     In the type signature: x :: ((# #)) => ()
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 503cab3bcb609dd3779321bcaf060287cbe4ccd5..28c586e804c0fca79c9cb80e64e1ec29449bc654 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -103,3 +103,4 @@ test('T8501b', normal, compile_fail, [''])
 test('T8501c', normal, compile_fail, [''])
 test('T12610', normal, compile_fail, [''])
 test('InfixAppPatErr', normal, compile_fail, [''])
+test('T14740', normal, compile_fail, [''])