From ee91f93bc76a6ddd399c9fbbb194441497ffa523 Mon Sep 17 00:00:00 2001
From: Kevin Buhr <buhr@asaurus.net>
Date: Thu, 9 May 2019 21:46:48 -0500
Subject: [PATCH] Add test for old issue displaying unboxed tuples in error
 messages (#502)

---
 testsuite/tests/typecheck/should_fail/T502.hs     | 10 ++++++++++
 testsuite/tests/typecheck/should_fail/T502.stderr | 12 ++++++++++++
 testsuite/tests/typecheck/should_fail/all.T       |  1 +
 3 files changed, 23 insertions(+)
 create mode 100644 testsuite/tests/typecheck/should_fail/T502.hs
 create mode 100644 testsuite/tests/typecheck/should_fail/T502.stderr

diff --git a/testsuite/tests/typecheck/should_fail/T502.hs b/testsuite/tests/typecheck/should_fail/T502.hs
new file mode 100644
index 00000000000..c73b7ac0e2f
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T502.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+module T502 where
+
+-- As per #502, the following type error message should correctly
+-- display the unboxed tuple type.
+bar :: Int
+bar = snd foo
+  where foo :: (# Int, Int #)
+        foo = undefined
diff --git a/testsuite/tests/typecheck/should_fail/T502.stderr b/testsuite/tests/typecheck/should_fail/T502.stderr
new file mode 100644
index 00000000000..ba5f6d157ab
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T502.stderr
@@ -0,0 +1,12 @@
+
+T502.hs:8:11: error:
+    • Couldn't match expected type ‘(a0, Int)’
+                  with actual type ‘(# Int, Int #)’
+    • In the first argument of ‘snd’, namely ‘foo’
+      In the expression: snd foo
+      In an equation for ‘bar’:
+          bar
+            = snd foo
+            where
+                foo :: (# Int, Int #)
+                foo = undefined
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index c51398f00b9..60d556b800d 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -515,3 +515,4 @@ test('T16204c', normal, compile_fail, [''])
 test('T16394', normal, compile_fail, [''])
 test('T16414', normal, compile_fail, [''])
 test('T16627', normal, compile_fail, [''])
+test('T502', normal, compile_fail, [''])
-- 
GitLab