[commit: ghc] master: Fix Trac #9815 (4ba4cc7)

Fri Nov 21 13:03:35 UTC 2014

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/4ba4cc7aaaf2bff31bc8474c8ba40e1cbe3e3875/ghc

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

commit 4ba4cc7aaaf2bff31bc8474c8ba40e1cbe3e3875
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Nov 21 13:02:45 2014 +0000

    Fix Trac #9815
    
    Dot-dot record-wildcard notation is simply illegal for constructors
    without any named fields, but that was neither documented nor checked.
    This patch does so
    
    - Make the check in RnPat
    - Add test T9815
    - Fix CmmLayoutStack which was using the illegal form (!)
    - Document in user manual


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

4ba4cc7aaaf2bff31bc8474c8ba40e1cbe3e3875
 compiler/cmm/CmmLayoutStack.hs                  |  6 +++---
 compiler/rename/RnPat.lhs                       | 14 ++++++++++----
 docs/users_guide/glasgow_exts.xml               | 14 +++++++++++++-
 testsuite/tests/rename/should_fail/T9815.hs     |  6 ++++++
 testsuite/tests/rename/should_fail/T9815.stderr |  4 ++++
 testsuite/tests/rename/should_fail/all.T        |  1 +
 6 files changed, 37 insertions(+), 8 deletions(-)

diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index c9399b3..5a2891f 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -415,9 +415,9 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
        return $ lastCall cont_lbl (wORD_SIZE dflags) ret_args ret_off
             -- one word of args: the return address
 
-    CmmBranch{..}     ->  handleBranches
-    CmmCondBranch{..} ->  handleBranches
-    CmmSwitch{..}     ->  handleBranches
+    CmmBranch {}     ->  handleBranches
+    CmmCondBranch {} ->  handleBranches
+    CmmSwitch {}     ->  handleBranches
 
   where
      -- Calls and ForeignCalls are handled the same way:
diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index aa41361..9d03805 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -516,7 +516,7 @@ rnHsRecFields
     -> HsRecFields RdrName (Located arg)
     -> RnM ([HsRecField Name (Located arg)], FreeVars)
 
--- This supprisingly complicated pass
+-- This surprisingly complicated pass
 --   a) looks up the field name (possibly using disambiguation)
 --   b) fills in puns and dot-dot stuff
 -- When we we've finished, we've renamed the LHS, but not the RHS,
@@ -576,7 +576,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
       = return []
     rn_dotdot (Just {}) Nothing _flds   -- ".." on record update
       = do { case ctxt of
-                HsRecFieldUpd -> addErr badDotDot
+                HsRecFieldUpd -> addErr badDotDotUpd
                 _             -> return ()
            ; return [] }
     rn_dotdot (Just n) (Just con) flds -- ".." on record construction / pat match
@@ -586,6 +586,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
            ; checkErr dd_flag (needFlagDotDot ctxt)
            ; (rdr_env, lcl_env) <- getRdrEnvs
            ; con_fields <- lookupConstructorFields con
+           ; when (null con_fields) (addErr (badDotDotCon con))
            ; let present_flds = getFieldIds flds
                  parent_tc = find_tycon rdr_env con
 
@@ -655,8 +656,13 @@ needFlagDotDot :: HsRecFieldContext -> SDoc
 needFlagDotDot ctxt = vcat [ptext (sLit "Illegal `..' in record") <+> pprRFC ctxt,
                             ptext (sLit "Use RecordWildCards to permit this")]
 
-badDotDot :: SDoc
-badDotDot = ptext (sLit "You cannot use `..' in a record update")
+badDotDotCon :: Name -> SDoc
+badDotDotCon con
+  = vcat [ ptext (sLit "Illegal `..' notation for constructor") <+> quotes (ppr con)
+         , nest 2 (ptext (sLit "The constructor has no labelled fields")) ]
+
+badDotDotUpd :: SDoc
+badDotDotUpd = ptext (sLit "You cannot use `..' in a record update")
 
 emptyUpdateErr :: SDoc
 emptyUpdateErr = ptext (sLit "Empty record update")
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index 30742b3..a21e677 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -2337,7 +2337,7 @@ More details:
 <itemizedlist>
 <listitem><para>
 Record wildcards in patterns can be mixed with other patterns, including puns
-(<xref linkend="record-puns"/>); for example, in a pattern <literal>C {a
+(<xref linkend="record-puns"/>); for example, in a pattern <literal>(C {a
 = 1, b, ..})</literal>.  Additionally, record wildcards can be used
 wherever record patterns occur, including in <literal>let</literal>
 bindings and at the top-level.  For example, the top-level binding
@@ -2404,6 +2404,18 @@ and omitting <literal>c</literal> since the variable <literal>c</literal>
 is not in scope (apart from the binding of the
 record selector <literal>c</literal>, of course).
 </para></listitem>
+
+<listitem><para>
+Record wildcards cannot be used (a) in a record update construct, and (b) for data
+constructors that are not declared with record fields.  For example:
+<programlisting>
+f x = x { v=True, .. }   -- Illegal (a)
+
+data T = MkT Int Bool
+g = MkT { .. }           -- Illegal (b)
+h (MkT { .. }) = True    -- Illegal (b)
+</programlisting>
+</para></listitem>
 </itemizedlist>
 </para>
 
diff --git a/testsuite/tests/rename/should_fail/T9815.hs b/testsuite/tests/rename/should_fail/T9815.hs
new file mode 100644
index 0000000..7d7ae66
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9815.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE RecordWildCards #-}
+module T9815 where
+
+newtype N = N Int deriving (Show)
+
+foo = print N{..}
diff --git a/testsuite/tests/rename/should_fail/T9815.stderr b/testsuite/tests/rename/should_fail/T9815.stderr
new file mode 100644
index 0000000..99f16b6
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9815.stderr
@@ -0,0 +1,4 @@
+
+T9815.hs:6:13:
+    Illegal `..' notation for constructor ‘N’
+      The constructor has no labelled fields
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index f2664dc..56d0f87 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -119,3 +119,4 @@ test('T9177', normal, compile_fail, [''])
 test('T9436', normal, compile_fail, [''])
 test('T9437', normal, compile_fail, [''])
 test('T9077', normal, compile_fail, [''])
+test('T9815', normal, compile_fail, [''])

