[commit: ghc] master: Fix missing fields warnings in empty record construction, fix #13870 (9e227bb)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/9e227bb19b8ceb129ce28e72aa070b3ba85accf7/ghc

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

commit 9e227bb19b8ceb129ce28e72aa070b3ba85accf7
Author: HE, Tao <sighingnow at gmail.com>
Date:   Fri Sep 15 14:34:42 2017 -0400

    Fix missing fields warnings in empty record construction, fix #13870
    
    Test Plan: make test TEST=T13870
    
    Reviewers: RyanGlScott, austin, bgamari, mpickering
    
    Reviewed By: mpickering
    
    Subscribers: mpickering, rwbarton, thomie, RyanGlScott
    
    Tags: #ghc
    
    GHC Trac Issues: #13870
    
    Differential Revision: https://phabricator.haskell.org/D3940


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

9e227bb19b8ceb129ce28e72aa070b3ba85accf7
 compiler/typecheck/TcExpr.hs                        | 21 ++++++++++++++-------
 testsuite/tests/deSugar/should_compile/T13870.hs    | 14 ++++++++++++++
 .../tests/deSugar/should_compile/T13870.stderr      | 10 ++++++++++
 testsuite/tests/deSugar/should_compile/all.T        |  1 +
 4 files changed, 39 insertions(+), 7 deletions(-)

diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 0ff7d1e..f88eb5c 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -2421,17 +2421,20 @@ checkMissingFields con_like rbinds
   = if any isBanged field_strs then
         -- Illegal if any arg is strict
         addErrTc (missingStrictFields con_like [])
-    else
-        return ()
+    else do
+        warn <- woptM Opt_WarnMissingFields
+        when (warn && notNull field_strs && null field_labels)
+             (warnTc (Reason Opt_WarnMissingFields) True
+                 (missingFields con_like []))
 
   | otherwise = do              -- A record
     unless (null missing_s_fields)
            (addErrTc (missingStrictFields con_like missing_s_fields))
 
     warn <- woptM Opt_WarnMissingFields
-    unless (not (warn && notNull missing_ns_fields))
-           (warnTc (Reason Opt_WarnMissingFields) True
-               (missingFields con_like missing_ns_fields))
+    when (warn && notNull missing_ns_fields)
+         (warnTc (Reason Opt_WarnMissingFields) True
+             (missingFields con_like missing_ns_fields))
 
   where
     missing_s_fields
@@ -2692,8 +2695,12 @@ missingStrictFields con fields
 
 missingFields :: ConLike -> [FieldLabelString] -> SDoc
 missingFields con fields
-  = text "Fields of" <+> quotes (ppr con) <+> ptext (sLit "not initialised:")
-        <+> pprWithCommas ppr fields
+  = header <> rest
+  where
+    rest | null fields = Outputable.empty
+         | otherwise = colon <+> pprWithCommas ppr fields
+    header = text "Fields of" <+> quotes (ppr con) <+>
+             text "not initialised"
 
 -- callCtxt fun args = text "In the call" <+> parens (ppr (foldl mkHsApp fun args))
 
diff --git a/testsuite/tests/deSugar/should_compile/T13870.hs b/testsuite/tests/deSugar/should_compile/T13870.hs
new file mode 100644
index 0000000..90ad9f0
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T13870.hs
@@ -0,0 +1,14 @@
+-- !!! T13870 -- missing-fields warnings for recprd-construction
+
+module ShouldCompile where
+
+import Data.Functor.Identity
+
+test1 :: Maybe Int
+test1 = Just{}
+
+test2 :: Maybe Int
+test2 = Nothing{}
+
+test3 :: Identity Int
+test3 = Identity{}
diff --git a/testsuite/tests/deSugar/should_compile/T13870.stderr b/testsuite/tests/deSugar/should_compile/T13870.stderr
new file mode 100644
index 0000000..5586806
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T13870.stderr
@@ -0,0 +1,10 @@
+
+T13870.hs:8:9: warning: [-Wmissing-fields (in -Wdefault)]
+    • Fields of ‘Just’ not initialised
+    • In the expression: Just {}
+      In an equation for ‘test1’: test1 = Just {}
+
+T13870.hs:14:9: warning: [-Wmissing-fields (in -Wdefault)]
+    • Fields of ‘Identity’ not initialised: runIdentity
+    • In the expression: Identity {}
+      In an equation for ‘test3’: test3 = Identity {}
diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T
index 7a39b1e..0a20fbb 100644
--- a/testsuite/tests/deSugar/should_compile/all.T
+++ b/testsuite/tests/deSugar/should_compile/all.T
@@ -98,3 +98,4 @@ test('T13043', normal, compile, [''])
 test('T13215', normal, compile, [''])
 test('T13290', normal, compile, [''])
 test('T13257', normal, compile, [''])
+test('T13870', normal, compile, [''])