Don't complain about UNPACK in -fno-code.
authorEdward Z. Yang <ezyang@fb.com>
Mon, 27 Nov 2017 14:45:23 +0000 (09:45 -0500)
committerBen Gamari <ben@smart-cactus.org>
Mon, 27 Nov 2017 14:45:38 +0000 (09:45 -0500)
Test Plan: validate

Reviewers: ekmett, austin, bgamari

Reviewed By: bgamari

Subscribers: duog, goldfire, rwbarton, thomie

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

compiler/typecheck/TcTyClsDecls.hs
testsuite/tests/backpack/should_run/all.T
testsuite/tests/backpack/should_run/bkprun09.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_run/bkprun09.stdout [new file with mode: 0644]

index 9798183..b6fe855 100644 (file)
@@ -2583,9 +2583,17 @@ checkValidDataCon dflags existential_ok tc con
       = addWarnTc NoReason (bad_bang n (text "UNPACK pragma lacks '!'"))
       | isSrcUnpacked want_unpack
       , case rep_bang of { HsUnpack {} -> False; _ -> True }
+      -- If not optimising, we don't unpack (rep_bang is never
+      -- HsUnpack), so don't complain!  This happens, e.g., in Haddock.
+      -- See dataConSrcToImplBang.
       , not (gopt Opt_OmitInterfacePragmas dflags)
-           -- If not optimising, se don't unpack, so don't complain!
-           -- See MkId.dataConArgRep, the (HsBang True) case
+      -- When typechecking an indefinite package in Backpack, we
+      -- may attempt to UNPACK an abstract type.  The test here will
+      -- conclude that this is unusable, but it might become usable
+      -- when we actually fill in the abstract type.  As such, don't
+      -- warn in this case (it gives users the wrong idea about whether
+      -- or not UNPACK on abstract types is supported; it is!)
+      , unitIdIsDefinite (thisPackage dflags)
       = addWarnTc NoReason (bad_bang n (text "Ignoring unusable UNPACK pragma"))
       where
         is_strict = case strict_mark of
index 436e142..48ed0c6 100644 (file)
@@ -6,4 +6,5 @@ test('bkprun05', exit_code(1), backpack_run, [''])
 test('bkprun06', normal, backpack_run, [''])
 test('bkprun07', normal, backpack_run, [''])
 test('bkprun08', normal, backpack_run, [''])
+test('bkprun09', normal, backpack_run, ['-O'])
 test('T13955', normal, backpack_run, [''])
diff --git a/testsuite/tests/backpack/should_run/bkprun09.bkp b/testsuite/tests/backpack/should_run/bkprun09.bkp
new file mode 100644 (file)
index 0000000..6608268
--- /dev/null
@@ -0,0 +1,22 @@
+unit a where
+    module A where
+        type T = Int
+        y :: Int
+        y = 4
+
+unit p where
+    signature A where
+        data T
+        instance Show T
+        y :: T
+    module P where
+        import A
+        data S = S {-# UNPACK #-} !T
+            deriving (Show)
+        x = S y
+
+unit main where
+    dependency p[A=a:A]
+    module Main where
+        import P
+        main = print x
diff --git a/testsuite/tests/backpack/should_run/bkprun09.stdout b/testsuite/tests/backpack/should_run/bkprun09.stdout
new file mode 100644 (file)
index 0000000..05b43db
--- /dev/null
@@ -0,0 +1 @@
+S 4