Fix missing fields warnings in empty record construction, fix #13870
authorHE, Tao <sighingnow@gmail.com>
Fri, 15 Sep 2017 18:34:42 +0000 (14:34 -0400)
committerBen Gamari <ben@smart-cactus.org>
Fri, 15 Sep 2017 18:34:53 +0000 (14:34 -0400)
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

compiler/typecheck/TcExpr.hs
testsuite/tests/deSugar/should_compile/T13870.hs [new file with mode: 0644]
testsuite/tests/deSugar/should_compile/T13870.stderr [new file with mode: 0644]
testsuite/tests/deSugar/should_compile/all.T

index 0ff7d1e..f88eb5c 100644 (file)
@@ -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 (file)
index 0000000..90ad9f0
--- /dev/null
@@ -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 (file)
index 0000000..5586806
--- /dev/null
@@ -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 {}
index 7a39b1e..0a20fbb 100644 (file)
@@ -98,3 +98,4 @@ test('T13043', normal, compile, [''])
 test('T13215', normal, compile, [''])
 test('T13290', normal, compile, [''])
 test('T13257', normal, compile, [''])
+test('T13870', normal, compile, [''])