[commit: ghc] master: Don't complain about UNPACK in -fno-code. (471d677)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/471d6777b94d04ca35fb643834e87b4eb3446e64/ghc

>---------------------------------------------------------------

commit 471d6777b94d04ca35fb643834e87b4eb3446e64
Author: Edward Z. Yang <ezyang at fb.com>
Date:   Mon Nov 27 09:45:23 2017 -0500

    Don't complain about UNPACK in -fno-code.
    
    Test Plan: validate
    
    Reviewers: ekmett, austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: duog, goldfire, rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D4155


>---------------------------------------------------------------

471d6777b94d04ca35fb643834e87b4eb3446e64
 compiler/typecheck/TcTyClsDecls.hs                 | 12 ++++++++++--
 testsuite/tests/backpack/should_run/all.T          |  1 +
 testsuite/tests/backpack/should_run/bkprun09.bkp   | 22 ++++++++++++++++++++++
 .../tests/backpack/should_run/bkprun09.stdout      |  1 +
 4 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 9798183..b6fe855 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -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
diff --git a/testsuite/tests/backpack/should_run/all.T b/testsuite/tests/backpack/should_run/all.T
index 436e142..48ed0c6 100644
--- a/testsuite/tests/backpack/should_run/all.T
+++ b/testsuite/tests/backpack/should_run/all.T
@@ -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
index 0000000..6608268
--- /dev/null
+++ b/testsuite/tests/backpack/should_run/bkprun09.bkp
@@ -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
index 0000000..05b43db
--- /dev/null
+++ b/testsuite/tests/backpack/should_run/bkprun09.stdout
@@ -0,0 +1 @@
+S 4