Improve error message for UNPACK/strictness annotations.
authorHE, Tao <sighingnow@gmail.com>
Sun, 18 Feb 2018 16:10:37 +0000 (11:10 -0500)
committerBen Gamari <ben@smart-cactus.org>
Sun, 18 Feb 2018 16:57:46 +0000 (11:57 -0500)
Print different error message for improper UNPACK and strictness
annotations.  Fix Trac #14761.

Signed-off-by: HE, Tao <sighingnow@gmail.com>
Test Plan: make test TEST="T7210 T14761a T14761b"

Reviewers: goldfire, bgamari, RyanGlScott, simonpj

Reviewed By: RyanGlScott, simonpj

Subscribers: simonpj, goldfire, rwbarton, thomie, carter

GHC Trac Issues: #14761

Differential Revision: https://phabricator.haskell.org/D4397

compiler/typecheck/TcHsType.hs
testsuite/tests/typecheck/should_fail/T14761a.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T14761a.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T14761b.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T14761b.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T7210.stderr
testsuite/tests/typecheck/should_fail/all.T

index 08dc56d..a8b9fe8 100644 (file)
@@ -559,11 +559,18 @@ tc_hs_type :: TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType
 
 tc_hs_type mode (HsParTy ty)   exp_kind = tc_lhs_type mode ty exp_kind
 tc_hs_type mode (HsDocTy ty _) exp_kind = tc_lhs_type mode ty exp_kind
-tc_hs_type _ ty@(HsBangTy {}) _
+tc_hs_type _ ty@(HsBangTy bang _) _
     -- While top-level bangs at this point are eliminated (eg !(Maybe Int)),
     -- other kinds of bangs are not (eg ((!Maybe) Int)). These kinds of
-    -- bangs are invalid, so fail. (#7210)
-    = failWithTc (text "Unexpected strictness annotation:" <+> ppr ty)
+    -- bangs are invalid, so fail. (#7210, #14761)
+    = do { let bangError err = failWith $
+                 text "Unexpected" <+> text err <+> text "annotation:" <+> ppr ty $$
+                 text err <+> text "annotation cannot appear nested inside a type"
+         ; case bang of
+             HsSrcBang _ SrcUnpack _           -> bangError "UNPACK"
+             HsSrcBang _ SrcNoUnpack _         -> bangError "NOUNPACK"
+             HsSrcBang _ NoSrcUnpack SrcLazy   -> bangError "laziness"
+             HsSrcBang _ _ _                   -> bangError "strictness" }
 tc_hs_type _ ty@(HsRecTy _)      _
       -- Record types (which only show up temporarily in constructor
       -- signatures) should have been removed by now
diff --git a/testsuite/tests/typecheck/should_fail/T14761a.hs b/testsuite/tests/typecheck/should_fail/T14761a.hs
new file mode 100644 (file)
index 0000000..f195320
--- /dev/null
@@ -0,0 +1,3 @@
+module T14761a where
+
+data A = A { a :: {-# UNPACK #-} Maybe Int}
diff --git a/testsuite/tests/typecheck/should_fail/T14761a.stderr b/testsuite/tests/typecheck/should_fail/T14761a.stderr
new file mode 100644 (file)
index 0000000..8eb4580
--- /dev/null
@@ -0,0 +1,7 @@
+
+T14761a.hs:3:19:
+     Unexpected UNPACK annotation: {-# UNPACK #-}Maybe
+      UNPACK annotation cannot appear nested inside a type
+     In the type ‘{-# UNPACK #-}Maybe Int’
+     In the definition of data constructor ‘A’
+     In the data declaration for ‘A’
diff --git a/testsuite/tests/typecheck/should_fail/T14761b.hs b/testsuite/tests/typecheck/should_fail/T14761b.hs
new file mode 100644 (file)
index 0000000..cd51962
--- /dev/null
@@ -0,0 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+
+module T14761b where
+
+data A = A { a :: ! Maybe Int}
diff --git a/testsuite/tests/typecheck/should_fail/T14761b.stderr b/testsuite/tests/typecheck/should_fail/T14761b.stderr
new file mode 100644 (file)
index 0000000..8357187
--- /dev/null
@@ -0,0 +1,7 @@
+
+T14761b.hs:5:19:
+     Unexpected strictness annotation: !Maybe
+      strictness annotation cannot appear nested inside a type
+     In the type ‘!Maybe Int’
+     In the definition of data constructor ‘A’
+     In the data declaration for ‘A’
index a7ee2af..314ffa7 100644 (file)
@@ -1,6 +1,7 @@
 
 T7210.hs:5:19:
     Unexpected strictness annotation: !IntMap
+     strictness annotation cannot appear nested inside a type
     In the type ‘!IntMap Int’
     In the definition of data constructor ‘C’
     In the data declaration for ‘T’
index b8c3c4c..20ed5a4 100644 (file)
@@ -465,3 +465,5 @@ test('MissingExportList03', normal, compile_fail, [''])
 test('T14618', normal, compile_fail, [''])
 test('T14607', normal, compile, [''])
 test('T14605', normal, compile_fail, [''])
+test('T14761a', normal, compile_fail, [''])
+test('T14761b', normal, compile_fail, [''])