diff options
| author | HE, Tao <sighingnow@gmail.com> | 2017-09-15 14:34:42 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-09-15 14:34:53 -0400 |
| commit | 9e227bb19b8ceb129ce28e72aa070b3ba85accf7 (patch) | |
| tree | 16493f7d360dbbee0f7fae502f84e534677ec3c5 /compiler | |
| parent | 43401652fd36b650521ab66be9b20dde3a10ca4c (diff) | |
| download | haskell-9e227bb19b8ceb129ce28e72aa070b3ba85accf7.tar.gz | |
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
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/typecheck/TcExpr.hs | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 0ff7d1e0d9..f88eb5c803 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)) |