diff options
author | Adam Gundry <adam@well-typed.com> | 2020-10-02 20:23:27 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-12-24 16:34:49 -0500 |
commit | 6f8bafb4fbddd2c8a113f5ddb04636a3a1be9355 (patch) | |
tree | 7169b8ce5f972892c498c30ee48db2028e76edac /testsuite/tests | |
parent | 9809474462527d36b9e237ee7012b08e0845b714 (diff) | |
download | haskell-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/tests')
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']) |