summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorAdam Gundry <adam@well-typed.com>2020-10-02 20:23:27 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-12-24 16:34:49 -0500
commit6f8bafb4fbddd2c8a113f5ddb04636a3a1be9355 (patch)
tree7169b8ce5f972892c498c30ee48db2028e76edac /testsuite
parent9809474462527d36b9e237ee7012b08e0845b714 (diff)
downloadhaskell-6f8bafb4fbddd2c8a113f5ddb04636a3a1be9355.tar.gz
Refactor renamer datastructures
This patch significantly refactors key renamer datastructures (primarily Avail and GlobalRdrElt) in order to treat DuplicateRecordFields in a more robust way. In particular it allows the extension to be used with pattern synonyms (fixes where mangled record selector names could be printed instead of field labels (e.g. with -Wpartial-fields or hole fits, see new tests). The key idea is the introduction of a new type GreName for names that may represent either normal entities or field labels. This is then used in GlobalRdrElt and AvailInfo, in place of the old way of representing fields using FldParent (yuck) and an extra list in AvailTC. Updates the haddock submodule.
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/T13438.hs3
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/T13438.script5
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/T13438.stdout10
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/all.T1
-rw-r--r--testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.hs4
-rw-r--r--testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.stdout1
-rw-r--r--testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport_A.hs5
-rw-r--r--testsuite/tests/overloadedrecflds/should_compile/Makefile10
-rw-r--r--testsuite/tests/overloadedrecflds/should_compile/T17176.hs16
-rw-r--r--testsuite/tests/overloadedrecflds/should_compile/all.T2
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/DRF9156.hs4
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/DRF9156.stderr5
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.hs8
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr24
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits_A.hs6
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.hs4
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.stderr3
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/T16745.stderr14
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/T16745A.hs6
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/T16745B.hs11
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/T16745C.hs2
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/T16745D.hs4
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/all.T4
-rw-r--r--testsuite/tests/parser/should_compile/T14189.stderr26
-rw-r--r--testsuite/tests/patsyn/should_compile/T11959.stderr3
-rw-r--r--testsuite/tests/patsyn/should_compile/T14630.hs16
-rw-r--r--testsuite/tests/patsyn/should_compile/all.T3
27 files changed, 187 insertions, 13 deletions
diff --git a/testsuite/tests/overloadedrecflds/ghci/T13438.hs b/testsuite/tests/overloadedrecflds/ghci/T13438.hs
new file mode 100644
index 0000000000..a23a16c1f3
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/ghci/T13438.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+module T13438 where
+data T = MkT { foo :: Int }
diff --git a/testsuite/tests/overloadedrecflds/ghci/T13438.script b/testsuite/tests/overloadedrecflds/ghci/T13438.script
new file mode 100644
index 0000000000..04bce206ca
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/ghci/T13438.script
@@ -0,0 +1,5 @@
+:l T13438.hs
+:browse! T13438
+:browse T13438
+:ctags
+:!cat tags
diff --git a/testsuite/tests/overloadedrecflds/ghci/T13438.stdout b/testsuite/tests/overloadedrecflds/ghci/T13438.stdout
new file mode 100644
index 0000000000..6c199b4c66
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/ghci/T13438.stdout
@@ -0,0 +1,10 @@
+-- defined locally
+type T :: *
+data T = ...
+MkT :: Int -> T
+foo :: T -> Int
+type T :: *
+data T = MkT {foo :: Int}
+foo T13438.hs 3;" v file:
+MkT T13438.hs 3;" d
+T T13438.hs 3;" t
diff --git a/testsuite/tests/overloadedrecflds/ghci/all.T b/testsuite/tests/overloadedrecflds/ghci/all.T
index 6a95bb2744..e8c008d1df 100644
--- a/testsuite/tests/overloadedrecflds/ghci/all.T
+++ b/testsuite/tests/overloadedrecflds/ghci/all.T
@@ -1,2 +1,3 @@
test('duplicaterecfldsghci01', combined_output, ghci_script, ['duplicaterecfldsghci01.script'])
test('overloadedlabelsghci01', combined_output, ghci_script, ['overloadedlabelsghci01.script'])
+test('T13438', [expect_broken(13438), combined_output], ghci_script, ['T13438.script'])
diff --git a/testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.hs b/testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.hs
new file mode 100644
index 0000000000..9c8b12e752
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE DisambiguateRecordFields #-}
+module DRFPatSynExport where
+import DRFPatSynExport_A
+v = MkT { m = () }
diff --git a/testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.stdout b/testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.stdout
new file mode 100644
index 0000000000..763c80e822
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.stdout
@@ -0,0 +1 @@
+import DRFPatSynExport_A ( MkT, m )
diff --git a/testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport_A.hs b/testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport_A.hs
new file mode 100644
index 0000000000..c44a72a0fe
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport_A.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE PatternSynonyms #-}
+module DRFPatSynExport_A where
+data S = MkS { m :: Int }
+pattern MkT { m } = m
diff --git a/testsuite/tests/overloadedrecflds/should_compile/Makefile b/testsuite/tests/overloadedrecflds/should_compile/Makefile
new file mode 100644
index 0000000000..99f0a67f30
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_compile/Makefile
@@ -0,0 +1,10 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+DRFPatSynExport:
+ $(RM) DRFPatSynExport.hi DRFPatSynExport.o DRFPatSynExport.imports
+ $(RM) DRFPatSynExport_A.hi DRFPatSynExport_A.o
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c DRFPatSynExport_A.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c DRFPatSynExport.hs -ddump-minimal-imports
+ cat DRFPatSynExport.imports
diff --git a/testsuite/tests/overloadedrecflds/should_compile/T17176.hs b/testsuite/tests/overloadedrecflds/should_compile/T17176.hs
new file mode 100644
index 0000000000..22e11d1d6b
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_compile/T17176.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+module T17176 (Foo(Bar,bar,Baz)) where
+
+data Foo =
+ Bar { bar :: Int }
+ | BadBaz { baz :: Int }
+
+pattern Baz :: Int -> Foo
+pattern Baz{baz} = BadBaz baz
+
+pattern Woz :: Int -> Foo
+pattern Woz{baz} = Baz{baz=baz}
+
+foo = Baz { baz = 42 }
+woo (Woz{baz=z}) = z
diff --git a/testsuite/tests/overloadedrecflds/should_compile/all.T b/testsuite/tests/overloadedrecflds/should_compile/all.T
index d375d468f2..515b19635f 100644
--- a/testsuite/tests/overloadedrecflds/should_compile/all.T
+++ b/testsuite/tests/overloadedrecflds/should_compile/all.T
@@ -1,3 +1,5 @@
test('T11173', [], multimod_compile, ['T11173', '-v0'])
test('T12609', normal, compile, [''])
test('T16597', [], multimod_compile, ['T16597', '-v0'])
+test('T17176', normal, compile, [''])
+test('DRFPatSynExport', [], makefile_test, ['DRFPatSynExport'])
diff --git a/testsuite/tests/overloadedrecflds/should_fail/DRF9156.hs b/testsuite/tests/overloadedrecflds/should_fail/DRF9156.hs
new file mode 100644
index 0000000000..107b8047ec
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/DRF9156.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+module DRF9156 where
+data D = D1 { f1 :: Int }
+ | D2 { f1, f1 :: Int }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/DRF9156.stderr b/testsuite/tests/overloadedrecflds/should_fail/DRF9156.stderr
new file mode 100644
index 0000000000..ea1d10dc10
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/DRF9156.stderr
@@ -0,0 +1,5 @@
+
+DRF9156.hs:4:19: error:
+ Multiple declarations of ‘f1’
+ Declared at: DRF9156.hs:3:15
+ DRF9156.hs:4:19
diff --git a/testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.hs b/testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.hs
new file mode 100644
index 0000000000..bc7248f642
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+module DRFHoleFits where
+import qualified DRFHoleFits_A as A
+
+data T = MkT { foo :: Int }
+
+bar = _ :: T -> Int
+baz = _ :: A.S -> Int
diff --git a/testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr b/testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
new file mode 100644
index 0000000000..a5b406567f
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
@@ -0,0 +1,24 @@
+[1 of 2] Compiling DRFHoleFits_A ( DRFHoleFits_A.hs, DRFHoleFits_A.o )
+[2 of 2] Compiling DRFHoleFits ( DRFHoleFits.hs, DRFHoleFits.o )
+
+DRFHoleFits.hs:7:7: error:
+ • Found hole: _ :: T -> Int
+ • In the expression: _ :: T -> Int
+ In an equation for ‘bar’: bar = _ :: T -> Int
+ • Relevant bindings include
+ bar :: T -> Int (bound at DRFHoleFits.hs:7:1)
+ Valid hole fits include
+ foo :: T -> Int (defined at DRFHoleFits.hs:5:16)
+ bar :: T -> Int (defined at DRFHoleFits.hs:7:1)
+
+DRFHoleFits.hs:8:7: error:
+ • Found hole: _ :: A.S -> Int
+ • In the expression: _ :: A.S -> Int
+ In an equation for ‘baz’: baz = _ :: A.S -> Int
+ • Relevant bindings include
+ baz :: A.S -> Int (bound at DRFHoleFits.hs:8:1)
+ Valid hole fits include
+ baz :: A.S -> Int (defined at DRFHoleFits.hs:8:1)
+ DRFHoleFits_A.foo :: A.S -> Int
+ (imported qualified from ‘DRFHoleFits_A’ at DRFHoleFits.hs:3:1-35
+ (and originally defined at DRFHoleFits_A.hs:5:16-18))
diff --git a/testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits_A.hs b/testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits_A.hs
new file mode 100644
index 0000000000..02d9bddb99
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits_A.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module DRFHoleFits_A where
+
+data S = MkS { foo :: Int }
+data U = MkU { foo :: Int }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.hs b/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.hs
new file mode 100644
index 0000000000..5c5ec744bb
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Werror=partial-fields #-}
+module DRFPartialFields where
+data T = MkT1 { foo :: Int } | MkT2
diff --git a/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.stderr b/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.stderr
new file mode 100644
index 0000000000..1f9034e7b2
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/DRFPartialFields.stderr
@@ -0,0 +1,3 @@
+
+DRFPartialFields.hs:4:17: error: [-Wpartial-fields, -Werror=partial-fields]
+ Use of partial record field selector: ‘foo’
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T16745.stderr b/testsuite/tests/overloadedrecflds/should_fail/T16745.stderr
new file mode 100644
index 0000000000..6e1cac2fbe
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/T16745.stderr
@@ -0,0 +1,14 @@
+[1 of 4] Compiling T16745C ( T16745C.hs, T16745C.o )
+[2 of 4] Compiling T16745B ( T16745B.hs, T16745B.o )
+[3 of 4] Compiling T16745D ( T16745D.hs, T16745D.o )
+[4 of 4] Compiling T16745A ( T16745A.hs, T16745A.o )
+
+T16745A.hs:3:24: error:
+ Ambiguous name ‘field’ in import item. It could refer to:
+ T16745C.field
+ T16745B.R(field)
+
+T16745A.hs:4:24: error:
+ Ambiguous name ‘foo’ in import item. It could refer to:
+ T16745D.T(foo)
+ T16745D.S(foo)
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T16745A.hs b/testsuite/tests/overloadedrecflds/should_fail/T16745A.hs
new file mode 100644
index 0000000000..49dbeb3fac
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/T16745A.hs
@@ -0,0 +1,6 @@
+module T16745A where
+
+import T16745B hiding (field)
+import T16745D hiding (foo)
+
+wrong = foo -- should not be in scope
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T16745B.hs b/testsuite/tests/overloadedrecflds/should_fail/T16745B.hs
new file mode 100644
index 0000000000..1e549ba05d
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/T16745B.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+-- This module tries to export a record field 'field' (defined below) and a
+-- function 'field' (defined in another module), which shouldn't be allowed.
+module T16745B
+ ( R(field)
+ , module T16745C
+ ) where
+
+import T16745C
+
+data R = R { field :: Int}
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T16745C.hs b/testsuite/tests/overloadedrecflds/should_fail/T16745C.hs
new file mode 100644
index 0000000000..ddafe2db95
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/T16745C.hs
@@ -0,0 +1,2 @@
+module T16745C where
+field = ()
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T16745D.hs b/testsuite/tests/overloadedrecflds/should_fail/T16745D.hs
new file mode 100644
index 0000000000..ee98217d4c
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/T16745D.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+module T16745D where
+data S = MkS { foo :: Char }
+data T = MkT { foo :: Int }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/all.T b/testsuite/tests/overloadedrecflds/should_fail/all.T
index bc3c0650d2..09bee3ba06 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/all.T
+++ b/testsuite/tests/overloadedrecflds/should_fail/all.T
@@ -33,3 +33,7 @@ test('T14953', [extra_files(['T14953_A.hs', 'T14953_B.hs'])],
multimod_compile_fail, ['T14953', ''])
test('DuplicateExports', normal, compile_fail, [''])
test('T17965', normal, compile_fail, [''])
+test('DRFHoleFits', extra_files(['DRFHoleFits_A.hs']), multimod_compile_fail, ['DRFHoleFits', ''])
+test('DRFPartialFields', normal, compile_fail, [''])
+test('T16745', extra_files(['T16745C.hs', 'T16745B.hs']), multimod_compile_fail, ['T16745A', ''])
+test('DRF9156', normal, compile_fail, [''])
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index 52f2099d6e..8e79b4bc9f 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -123,7 +123,11 @@
[((,)
({ T14189.hs:3:3-15 }
(IEThingWith
- (NoExtField)
+ [({ T14189.hs:3:11 }
+ (FieldLabel
+ {FastString: "f"}
+ (False)
+ {Name: T14189.f}))]
({ T14189.hs:3:3-8 }
(IEName
({ T14189.hs:3:3-8 }
@@ -132,20 +136,18 @@
[({ T14189.hs:3:13-14 }
(IEName
({ T14189.hs:3:13-14 }
- {Name: T14189.NT})))]
- [({ T14189.hs:3:11 }
+ {Name: T14189.NT})))]))
+ [(AvailTC
+ {Name: T14189.MyType}
+ [(NormalGreName
+ {Name: T14189.MyType})
+ ,(NormalGreName
+ {Name: T14189.NT})
+ ,(FieldGreName
(FieldLabel
{FastString: "f"}
(False)
- {Name: T14189.f}))]))
- [(AvailTC
- {Name: T14189.MyType}
- [{Name: T14189.MyType}
- ,{Name: T14189.NT}]
- [(FieldLabel
- {FastString: "f"}
- (False)
- {Name: T14189.f})])])])
+ {Name: T14189.f}))])])])
(Nothing)))
diff --git a/testsuite/tests/patsyn/should_compile/T11959.stderr b/testsuite/tests/patsyn/should_compile/T11959.stderr
new file mode 100644
index 0000000000..4645f33641
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T11959.stderr
@@ -0,0 +1,3 @@
+
+T11959Lib.hs:2:35: warning: [-Wduplicate-exports (in -Wdefault)]
+ ‘:>’ is exported by ‘pattern (:>)’ and ‘Vec2(Nil, (:>))’
diff --git a/testsuite/tests/patsyn/should_compile/T14630.hs b/testsuite/tests/patsyn/should_compile/T14630.hs
new file mode 100644
index 0000000000..04aee67038
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T14630.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module T14630 where
+
+pattern Tuple :: a -> b -> (a, b)
+pattern Tuple{x, y} = (x, y)
+
+{-# COMPLETE Tuple #-}
+
+f :: (a, b) -> a
+f Tuple{x} = x
+
+g :: (Int, Int) -> Int
+g Tuple{..} = x + y
diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index 75be0c68b2..defb2ac52b 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -53,7 +53,7 @@ test('T11367', normal, compile, [''])
test('T11351', normal, compile, [''])
test('T11633', normal, compile, [''])
test('T11727', normal, compile, [''])
-test('T11959', expect_broken(11959), multimod_compile, ['T11959', '-v0'])
+test('T11959', normal, multimod_compile, ['T11959', '-v0'])
test('T12094', normal, compile, [''])
test('T11977', normal, compile, [''])
test('T12108', normal, compile, [''])
@@ -79,3 +79,4 @@ test('T14498', normal, compile, [''])
test('T16682', [extra_files(['T16682.hs', 'T16682a.hs'])],
multimod_compile, ['T16682', '-v0 -fwarn-incomplete-patterns -fno-code'])
test('T17775-singleton', normal, compile, [''])
+test('T14630', normal, compile, ['-Wname-shadowing'])