diff options
author | John Ericson <John.Ericson@Obsidian.Systems> | 2019-09-20 16:50:29 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-10-17 22:01:38 -0400 |
commit | 59d7c9f45b034809516703b57c84e3dac1834578 (patch) | |
tree | e1caa111d009cd3524293c06b6538a30abfb420b /testsuite/tests | |
parent | b02a9ea79dddd98f6bbb42e1652d7ea38db7d55e (diff) | |
download | haskell-59d7c9f45b034809516703b57c84e3dac1834578.tar.gz |
Skip type family defaults with hs-boot and hsig files
Works around #17190, possible resolution for #17224. New design is is
according to accepted [GHC Propoal 320].
Instances in signatures currently unconditionally opt into associated
family defaults if no explicit instance is given. This is bad for two
reasons:
1. It constrains possible instantiations to use the default, rather
than possibly define the associated family differently.
2. It breaks compilation as type families are unsupported in
signatures.
This PR simply turns off the filling in of defaults in those cases.
Additionally, it squelches a missing definition warning for hs-boot too
that was only squelched for hsig before.
The downsides are:
1. There is no way to opt into the default, other than copying its
definition.
2. If we fixed type classes in signatures, and wanted instances to
have to explicitly *out of* rather than into the default, that would
now be a breaking change.
The change that is most unambiguously goood is harmonizing the warning
squelching between hs-boot or hsig. Maybe they should have the warning
(opt out of default) maybe they shouldn't (opt in to default), but
surely it should be the same for both.
Add hs-boot version of a backpack test regarding class-specified
defaults in instances that appear in an hs-boot file.
The metrics increase is very slight and makes no sense --- at least no
one has figured anything out after this languishing for a while, so I'm
just going to accept it.
Metric Increase:
T10421a
[GHC proposal 320]: https://github.com/ghc-proposals/ghc-proposals/pull/320
Diffstat (limited to 'testsuite/tests')
15 files changed, 253 insertions, 0 deletions
diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T index 6655e09360..ac8c2a7ed8 100644 --- a/testsuite/tests/backpack/should_compile/all.T +++ b/testsuite/tests/backpack/should_compile/all.T @@ -48,6 +48,10 @@ test('bkp53', normal, backpack_compile, ['']) test('bkp54', normal, backpack_compile, ['']) test('bkp55', normal, backpack_compile, ['']) test('bkp56', normal, backpack_compile, ['']) +test('bkp57', normal, backpack_compile, ['']) +test('bkp58', normal, backpack_compile, ['']) +test('bkp59', normal, backpack_compile, ['']) +test('bkp60', normal, backpack_compile, ['']) test('T13140', normal, backpack_compile, ['']) test('T13149', expect_broken(13149), backpack_compile, ['']) diff --git a/testsuite/tests/backpack/should_compile/bkp57.bkp b/testsuite/tests/backpack/should_compile/bkp57.bkp new file mode 100644 index 0000000000..51cc19b97c --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp57.bkp @@ -0,0 +1,37 @@ +-- no default method, backpack +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} +unit common where + module Class where + class Show (T x) => C x where + type T x + def :: T x + --type T x = () +unit consumer-abs where + dependency common + signature Instance where + import Class + data I = I Int + instance C I where + --type T I = () + module Downstream where + import Class + import Instance + asdf :: C I => String + asdf = show $ def @I +unit consumer-impl where + dependency common + module Impl where + import Class + data I = I Int + instance C I where + type T I = () + def = () +unit tie where + dependency consumer-impl + dependency consumer-abs[Instance=consumer-impl:Impl] + module Tie where + import Downstream + main = print asdf diff --git a/testsuite/tests/backpack/should_compile/bkp57.stderr b/testsuite/tests/backpack/should_compile/bkp57.stderr new file mode 100644 index 0000000000..96f769a402 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp57.stderr @@ -0,0 +1,19 @@ +[1 of 4] Processing common + Instantiating common + [1 of 1] Compiling Class ( common/Class.hs, bkp57.out/common/Class.o ) +[2 of 4] Processing consumer-abs + [1 of 2] Compiling Instance[sig] ( consumer-abs/Instance.hsig, nothing ) + [2 of 2] Compiling Downstream ( consumer-abs/Downstream.hs, nothing ) +[3 of 4] Processing consumer-impl + Instantiating consumer-impl + [1 of 1] Including common + [1 of 1] Compiling Impl ( consumer-impl/Impl.hs, bkp57.out/consumer-impl/Impl.o ) +[4 of 4] Processing tie + Instantiating tie + [1 of 2] Including consumer-impl + [2 of 2] Including consumer-abs[Instance=consumer-impl:Impl] + Instantiating consumer-abs[Instance=consumer-impl:Impl] + [1 of 1] Including common + [1 of 2] Compiling Instance[sig] ( consumer-abs/Instance.hsig, bkp57.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Instance.o ) + [2 of 2] Compiling Downstream ( consumer-abs/Downstream.hs, bkp57.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Downstream.o ) + [1 of 1] Compiling Tie ( tie/Tie.hs, bkp57.out/tie/Tie.o ) diff --git a/testsuite/tests/backpack/should_compile/bkp58.bkp b/testsuite/tests/backpack/should_compile/bkp58.bkp new file mode 100644 index 0000000000..6055e74496 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp58.bkp @@ -0,0 +1,35 @@ +-- no default method, hs-boot +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} +unit common where + module Class where + class Show (T x) => C x where + type T x + --type T x = () + def :: T x +unit consumer-impl where + dependency common + module {-# SOURCE #-} Impl where + import Class + data I = I Int + instance C I where + --type T I = () + module Downstream where + import Class + import {-# SOURCE #-} Impl + asdf :: C I => String + asdf = show $ def @I + module Impl where + import Class + data I = I Int + instance C I where + type T I = () + def = () +unit tie where + dependency consumer-impl + module Tie where + import Downstream + import Impl + main = print asdf diff --git a/testsuite/tests/backpack/should_compile/bkp58.stderr b/testsuite/tests/backpack/should_compile/bkp58.stderr new file mode 100644 index 0000000000..c5ce8bd55f --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp58.stderr @@ -0,0 +1,13 @@ +[1 of 3] Processing common + Instantiating common + [1 of 1] Compiling Class ( common/Class.hs, bkp58.out/common/Class.o ) +[2 of 3] Processing consumer-impl + Instantiating consumer-impl + [1 of 1] Including common + [1 of 3] Compiling Impl[boot] ( consumer-impl/Impl.hs-boot, bkp58.out/consumer-impl/Impl.o-boot ) + [2 of 3] Compiling Downstream ( consumer-impl/Downstream.hs, bkp58.out/consumer-impl/Downstream.o ) + [3 of 3] Compiling Impl ( consumer-impl/Impl.hs, bkp58.out/consumer-impl/Impl.o ) +[3 of 3] Processing tie + Instantiating tie + [1 of 1] Including consumer-impl + [1 of 1] Compiling Tie ( tie/Tie.hs, bkp58.out/tie/Tie.o ) diff --git a/testsuite/tests/backpack/should_compile/bkp59.bkp b/testsuite/tests/backpack/should_compile/bkp59.bkp new file mode 100644 index 0000000000..7ba77ec6c1 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp59.bkp @@ -0,0 +1,38 @@ +-- default method, backpack +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} +unit common where + module Class where + class Show (T x) => C x where + type T x + type T x = () + def :: T x + class D x where +unit consumer-abs where + dependency common + signature Instance where + import Class + data I = I Int + instance C I where + --type T I = () + module Downstream where + import Class + import Instance + asdf :: C I => String + asdf = show $ def @I +unit consumer-impl where + dependency common + module Impl where + import Class + data I = I Int + instance C I where + type T I = () + def = () +unit tie where + dependency consumer-impl + dependency consumer-abs[Instance=consumer-impl:Impl] + module Tie where + import Downstream + main = print asdf diff --git a/testsuite/tests/backpack/should_compile/bkp59.stderr b/testsuite/tests/backpack/should_compile/bkp59.stderr new file mode 100644 index 0000000000..364d6c2601 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp59.stderr @@ -0,0 +1,19 @@ +[1 of 4] Processing common + Instantiating common + [1 of 1] Compiling Class ( common/Class.hs, bkp59.out/common/Class.o ) +[2 of 4] Processing consumer-abs + [1 of 2] Compiling Instance[sig] ( consumer-abs/Instance.hsig, nothing ) + [2 of 2] Compiling Downstream ( consumer-abs/Downstream.hs, nothing ) +[3 of 4] Processing consumer-impl + Instantiating consumer-impl + [1 of 1] Including common + [1 of 1] Compiling Impl ( consumer-impl/Impl.hs, bkp59.out/consumer-impl/Impl.o ) +[4 of 4] Processing tie + Instantiating tie + [1 of 2] Including consumer-impl + [2 of 2] Including consumer-abs[Instance=consumer-impl:Impl] + Instantiating consumer-abs[Instance=consumer-impl:Impl] + [1 of 1] Including common + [1 of 2] Compiling Instance[sig] ( consumer-abs/Instance.hsig, bkp59.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Instance.o ) + [2 of 2] Compiling Downstream ( consumer-abs/Downstream.hs, bkp59.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Downstream.o ) + [1 of 1] Compiling Tie ( tie/Tie.hs, bkp59.out/tie/Tie.o ) diff --git a/testsuite/tests/backpack/should_compile/bkp60.bkp b/testsuite/tests/backpack/should_compile/bkp60.bkp new file mode 100644 index 0000000000..426ac1a75b --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp60.bkp @@ -0,0 +1,35 @@ +-- default method, hs-boot +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} +unit common where + module Class where + class Show (T x) => C x where + type T x + type T x = () + def :: T x +unit consumer-impl where + dependency common + module {-# SOURCE #-} Impl where + import Class + data I = I Int + instance C I where + --type T I = () + module Downstream where + import Class + import {-# SOURCE #-} Impl + asdf :: C I => String + asdf = show $ def @I + module Impl where + import Class + data I = I Int + instance C I where + type T I = () + def = () +unit tie where + dependency consumer-impl + module Tie where + import Downstream + import Impl + main = print asdf diff --git a/testsuite/tests/backpack/should_compile/bkp60.stderr b/testsuite/tests/backpack/should_compile/bkp60.stderr new file mode 100644 index 0000000000..070a908b17 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp60.stderr @@ -0,0 +1,13 @@ +[1 of 3] Processing common + Instantiating common + [1 of 1] Compiling Class ( common/Class.hs, bkp60.out/common/Class.o ) +[2 of 3] Processing consumer-impl + Instantiating consumer-impl + [1 of 1] Including common + [1 of 3] Compiling Impl[boot] ( consumer-impl/Impl.hs-boot, bkp60.out/consumer-impl/Impl.o-boot ) + [2 of 3] Compiling Downstream ( consumer-impl/Downstream.hs, bkp60.out/consumer-impl/Downstream.o ) + [3 of 3] Compiling Impl ( consumer-impl/Impl.hs, bkp60.out/consumer-impl/Impl.o ) +[3 of 3] Processing tie + Instantiating tie + [1 of 1] Including consumer-impl + [1 of 1] Compiling Tie ( tie/Tie.hs, bkp60.out/tie/Tie.o ) diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBoot.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBoot.hs new file mode 100644 index 0000000000..c066f70d55 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBoot.hs @@ -0,0 +1,4 @@ +import ClassDefaultInHsBootA3 +import ClassDefaultInHsBootA2 + +main = print asdf diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA1.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA1.hs new file mode 100644 index 0000000000..e83e1e8e8f --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA1.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +-- Analogous to module Class from tests/backpack/should_compile/bkp58.bkp +module ClassDefaultInHsBootA1 where + +class Show (T x) => C x where + type T x + type T x = Int + def :: T x diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs new file mode 100644 index 0000000000..a4dd9af667 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +module ClassDefaultInHsBootA2 where + +import ClassDefaultInHsBootA1 + +data I = I Int + +instance C I where + type T I = () + def = () diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs-boot b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs-boot new file mode 100644 index 0000000000..79cfe21342 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs-boot @@ -0,0 +1,6 @@ +module ClassDefaultInHsBootA2 where + +import ClassDefaultInHsBootA1 + +data I = I Int +instance C I diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA3.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA3.hs new file mode 100644 index 0000000000..c47e807608 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA3.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} +module ClassDefaultInHsBootA3 where + +import ClassDefaultInHsBootA1 +import ClassDefaultInHsBootA2 + +asdf :: String +asdf = show $ def @I diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index ad682924e2..953f2489c7 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -724,4 +724,5 @@ test('T18323', normal, compile, ['']) test('T18585', normal, compile, ['']) test('T18831', normal, compile, ['']) test('T15942', normal, compile, ['']) +test('ClassDefaultInHsBoot', [extra_files(['ClassDefaultInHsBootA1.hs','ClassDefaultInHsBootA2.hs','ClassDefaultInHsBootA2.hs-boot','ClassDefaultInHsBootA3.hs'])], multimod_compile, ['ClassDefaultInHsBoot', '-v0']) |