Fix Template Haskell bug reported in #11809.
authorDominik Bollmann <bollmann@seas.upenn.edu>
Sun, 10 Apr 2016 16:57:38 +0000 (18:57 +0200)
committerBen Gamari <ben@smart-cactus.org>
Sun, 10 Apr 2016 18:09:04 +0000 (20:09 +0200)
Record selectors of data types spliced in with Template Haskell are not
renamer-resolved correctly in GHC HEAD. The culprit is
`newRecordSelector` which violates notes `Note [Binders in Template
Haskell] in Convert.hs` and `Note [Looking up Exact RdrNames] in
RnEnv.hs`. This commit fixes `newRecordSelector` accordingly.

Test Plan: ./validate

Reviewers: thomie, mpickering, bgamari, austin, simonpj, goldfire

Reviewed By: goldfire

Differential Revision: https://phabricator.haskell.org/D2091

GHC Trac Issues: #11809

compiler/rename/RnNames.hs
testsuite/tests/th/T11809.hs [new file with mode: 0644]
testsuite/tests/th/all.T

index 1659191..0bc6386 100644 (file)
@@ -685,13 +685,20 @@ getLocalNonValBinders fixity_env
 
 newRecordSelector :: Bool -> [Name] -> LFieldOcc RdrName -> RnM FieldLabel
 newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
-newRecordSelector overload_ok (dc:_) (L loc (FieldOcc (L _ fld) _)) =
-  do { sel_name <- newTopSrcBinder $ L loc $ mkRdrUnqual sel_occ
-     ; return $ fl { flSelector = sel_name } }
+newRecordSelector overload_ok (dc:_) (L loc (FieldOcc (L _ fld) _))
+  = do { selName <- newTopSrcBinder $ L loc $ field
+       ; return $ qualFieldLbl { flSelector = selName } }
   where
-    lbl     = occNameFS $ rdrNameOcc fld
-    fl      = mkFieldLabelOccs lbl (nameOccName dc) overload_ok
-    sel_occ = flSelector fl
+    fieldOccName = occNameFS $ rdrNameOcc fld
+    qualFieldLbl = mkFieldLabelOccs fieldOccName (nameOccName dc) overload_ok
+    field | isExact fld = fld
+              -- use an Exact RdrName as is to preserve the bindings
+              -- of an already renamer-resolved field and its use
+              -- sites. This is needed to correctly support record
+              -- selectors in Template Haskell. See Note [Binders in
+              -- Template Haskell] in Convert.hs and Note [Looking up
+              -- Exact RdrNames] in RnEnv.hs.
+          | otherwise   = mkRdrUnqual (flSelector qualFieldLbl)
 
 {-
 Note [Looking up family names in family instances]
diff --git a/testsuite/tests/th/T11809.hs b/testsuite/tests/th/T11809.hs
new file mode 100644 (file)
index 0000000..bbb65fa
--- /dev/null
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T11809 where
+
+{- Test splicing in a data type with records -}
+
+[d|
+ data D a = MkD { unD :: a }
+
+ someD = MkD "Hello"
+ getD  = unD someD   -- unD should resolve to the record selector above!
+ |]
+
+getD' = unD someD    -- dito here outside of the splice!
index 3939880..621e2f8 100644 (file)
@@ -391,9 +391,9 @@ test('T10819',
 test('T10820', normal, compile_and_run, ['-v0'])
 test('T11341', normal, compile, ['-v0 -dsuppress-uniques'])
 test('T11345', normal, compile_and_run, ['-v0 -dsuppress-uniques'])
-
 test('TH_finalizer', normal, compile, ['-v0'])
 test('T10603', normal, compile, ['-ddump-splices -dsuppress-uniques'])
 test('T11452', normal, compile_fail, ['-v0'])
 test('T9022', normal, compile_and_run, ['-v0'])
 test('T11145', normal, compile_fail, ['-v0 -dsuppress-uniques'])
+test('T11809', normal, compile, ['-v0'])