diff options
Diffstat (limited to 'testsuite')
27 files changed, 53 insertions, 49 deletions
diff --git a/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs b/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs index b13aece069..a138615b2d 100644 --- a/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs +++ b/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs @@ -19,7 +19,7 @@ import Data.Map (Map) import Data.Bifunctor (second) import Packed.Bytes (Bytes) import qualified Data.Char -import qualified Data.List as L +import qualified GHC.OldList as L import qualified Packed.Bytes.Parser as P import qualified Packed.Bytes as B import qualified Data.Semigroup as SG diff --git a/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs index d4538506df..224e03f75d 100644 --- a/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs +++ b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs @@ -27,7 +27,7 @@ import Data.Primitive (ByteArray(..)) import Data.Word (Word8) import Control.Monad.ST (runST, ST) import qualified Data.Primitive as PM -import qualified Data.List as L +import qualified GHC.OldList as L data Bytes = Bytes {-# UNPACK #-} !ByteArray -- payload diff --git a/testsuite/tests/codeGen/should_run/T20137/T20137.hs b/testsuite/tests/codeGen/should_run/T20137/T20137.hs index 4786e27778..2fa33b5cd9 100644 --- a/testsuite/tests/codeGen/should_run/T20137/T20137.hs +++ b/testsuite/tests/codeGen/should_run/T20137/T20137.hs @@ -5,7 +5,7 @@ module Main where -import Data.List +import Data.List (foldl') import Data.Bits import GHC.Ptr import Foreign.Ptr diff --git a/testsuite/tests/ghci/scripts/T10663.script b/testsuite/tests/ghci/scripts/T10663.script index 406d0ca7ee..30f003050b 100644 --- a/testsuite/tests/ghci/scripts/T10663.script +++ b/testsuite/tests/ghci/scripts/T10663.script @@ -1,2 +1,2 @@ -import Data.List; xs = sort [2, 1] -xs
\ No newline at end of file +import Data.List (sort); xs = sort [2, 1] +xs diff --git a/testsuite/tests/ghci/scripts/T14828.stdout b/testsuite/tests/ghci/scripts/T14828.stdout index aeab49d226..90ba8f3c13 100644 --- a/testsuite/tests/ghci/scripts/T14828.stdout +++ b/testsuite/tests/ghci/scripts/T14828.stdout @@ -8,5 +8,5 @@ pure :: Applicative f => a -> f a pure = (_t4::Applicative f => a -> f a) mempty = (_t5::Monoid a => a) mappend = (_t6::Monoid a => a -> a -> a) -foldl' = (_t7::(b -> a -> b) -> b -> [a] -> b) +foldl' = (_t7::Foldable t => (b -> a -> b) -> b -> t a -> b) f = (_t8::(forall a. a -> a) -> b -> b) diff --git a/testsuite/tests/ghci/scripts/T20473a.script b/testsuite/tests/ghci/scripts/T20473a.script index d84edb4129..73e2355564 100644 --- a/testsuite/tests/ghci/scripts/T20473a.script +++ b/testsuite/tests/ghci/scripts/T20473a.script @@ -1,5 +1,5 @@ :{ -import Data.List +import Data.List (sort) xs :: [Int] xs = sort [2,1] diff --git a/testsuite/tests/ghci/scripts/T20473b.script b/testsuite/tests/ghci/scripts/T20473b.script index 4fb53badf3..e43ac8b6f7 100644 --- a/testsuite/tests/ghci/scripts/T20473b.script +++ b/testsuite/tests/ghci/scripts/T20473b.script @@ -1,2 +1,2 @@ -import Data.List; import Data.Function +import Data.List (sort); import Data.Function on (==) sort [1,2] [2,1] diff --git a/testsuite/tests/ghci/scripts/ghci008.stdout b/testsuite/tests/ghci/scripts/ghci008.stdout index 812dffc36a..3f62f3f7f2 100644 --- a/testsuite/tests/ghci/scripts/ghci008.stdout +++ b/testsuite/tests/ghci/scripts/ghci008.stdout @@ -40,5 +40,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ -Data.List.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘Data.List’ +base-4.13.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘base-4.13.0.0:Data.OldList’ diff --git a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun05.hs b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun05.hs index c1ed84d0fa..3abdd5da87 100644 --- a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun05.hs +++ b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun05.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedLists, TypeFamilies, RebindableSyntax #-} import Prelude +import Data.List main = do print [] print [0,3..20] diff --git a/testsuite/tests/parser/should_compile/DumpSemis.hs b/testsuite/tests/parser/should_compile/DumpSemis.hs index 9f2f9629d8..23ccd717a3 100644 --- a/testsuite/tests/parser/should_compile/DumpSemis.hs +++ b/testsuite/tests/parser/should_compile/DumpSemis.hs @@ -2,7 +2,7 @@ module DumpSemis where -- Make sure we get all the semicolons in statements ;;;; ;; -import Data.List +import Data.List () ; ; ; import Data.Kind ; ;; diff --git a/testsuite/tests/parser/should_compile/DumpSemis.stderr b/testsuite/tests/parser/should_compile/DumpSemis.stderr index b5836252ad..8f7b2252d8 100644 --- a/testsuite/tests/parser/should_compile/DumpSemis.stderr +++ b/testsuite/tests/parser/should_compile/DumpSemis.stderr @@ -47,7 +47,7 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { DumpSemis.hs:5:1-16 } + { DumpSemis.hs:5:1-19 } (UnchangedAnchor)) (AnnListItem [(AddSemiAnn @@ -57,7 +57,7 @@ ,(AddSemiAnn (EpaSpan { DumpSemis.hs:6:5 }))]) (EpaComments - [])) { DumpSemis.hs:5:1-16 }) + [])) { DumpSemis.hs:5:1-19 }) (ImportDecl (EpAnn (Anchor @@ -82,7 +82,25 @@ (NotQualified) (False) (Nothing) - (Nothing))) + (Just + ((,) + (False) + (L + (SrcSpanAnn (EpAnn + (Anchor + { DumpSemis.hs:5:18-19 } + (UnchangedAnchor)) + (AnnList + (Nothing) + (Just + (AddEpAnn AnnOpenP (EpaSpan { DumpSemis.hs:5:18 }))) + (Just + (AddEpAnn AnnCloseP (EpaSpan { DumpSemis.hs:5:19 }))) + [] + []) + (EpaComments + [])) { DumpSemis.hs:5:18-19 }) + []))))) ,(L (SrcSpanAnn (EpAnn (Anchor diff --git a/testsuite/tests/perf/compiler/T16875.hs b/testsuite/tests/perf/compiler/T16875.hs index 0ba3c17d5b..dcf93ad5ac 100644 --- a/testsuite/tests/perf/compiler/T16875.hs +++ b/testsuite/tests/perf/compiler/T16875.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-compat-unqualified-imports #-} module T16875 where import Control.Applicative diff --git a/testsuite/tests/perf/compiler/T16875.stderr b/testsuite/tests/perf/compiler/T16875.stderr index af6954792e..95c54362c3 100644 --- a/testsuite/tests/perf/compiler/T16875.stderr +++ b/testsuite/tests/perf/compiler/T16875.stderr @@ -1,12 +1,12 @@ -T16875.hs:12:5: warning: [-Wtyped-holes (in -Wdefault)] +T16875.hs:13:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: p Where: ‘p’ is a rigid type variable bound by the inferred type of a :: p - at T16875.hs:12:1-5 + at T16875.hs:13:1-5 • In an equation for ‘a’: a = _ - • Relevant bindings include a :: p (bound at T16875.hs:12:1) + • Relevant bindings include a :: p (bound at T16875.hs:13:1) Valid hole fits include a :: forall {p}. p with a - (defined at T16875.hs:12:1) + (defined at T16875.hs:13:1) diff --git a/testsuite/tests/perf/should_run/T5949.hs b/testsuite/tests/perf/should_run/T5949.hs index 7a65d582ce..f3f8cce0d3 100644 --- a/testsuite/tests/perf/should_run/T5949.hs +++ b/testsuite/tests/perf/should_run/T5949.hs @@ -1,4 +1,3 @@ -import Prelude hiding (foldr) import Data.List (foldr) {- diff --git a/testsuite/tests/rename/should_fail/T17244A.hs b/testsuite/tests/rename/should_compile/T17244A.hs index e0152d95d2..290120affd 100644 --- a/testsuite/tests/rename/should_fail/T17244A.hs +++ b/testsuite/tests/rename/should_compile/T17244A.hs @@ -2,8 +2,7 @@ module T17244A (hello) where --- This should NOT warn with -Wcompat-unqualified-imports, --- Instead this just fails. +-- This should warn with -Wcompat-unqualified-imports. import Data.List hello :: [Int] -> Int diff --git a/testsuite/tests/rename/should_compile/T17244A.stderr b/testsuite/tests/rename/should_compile/T17244A.stderr new file mode 100644 index 0000000000..621e9439f1 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T17244A.stderr @@ -0,0 +1,5 @@ + +T17244A.hs:6:8: warning: [-Wcompat-unqualified-imports (in -Wcompat)] + To ensure compatibility with future core libraries changes + imports to Data.List should be + either qualified or have an explicit import list. diff --git a/testsuite/tests/rename/should_fail/T17244C.hs b/testsuite/tests/rename/should_compile/T17244C.hs index e77ff39b61..3da92dddd6 100644 --- a/testsuite/tests/rename/should_fail/T17244C.hs +++ b/testsuite/tests/rename/should_compile/T17244C.hs @@ -3,7 +3,6 @@ module T17244C (hello) where -- This should not warn with -Wcompat-unqualified-imports. --- But not his fails, as sum name clashes with Prelude import Data.List (sum) hello :: [Int] -> Int diff --git a/testsuite/tests/rename/should_compile/T17244C.stderr b/testsuite/tests/rename/should_compile/T17244C.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T17244C.stderr diff --git a/testsuite/tests/rename/should_compile/T1972.stderr b/testsuite/tests/rename/should_compile/T1972.stderr index 779b2425ef..3311f0aded 100644 --- a/testsuite/tests/rename/should_compile/T1972.stderr +++ b/testsuite/tests/rename/should_compile/T1972.stderr @@ -6,6 +6,7 @@ T1972.hs:13:3: warning: [-Wname-shadowing (in -Wall)] T1972.hs:15:3: warning: [-Wname-shadowing (in -Wall)] This binding for ‘mapAccumL’ shadows the existing bindings imported from ‘Data.List’ at T1972.hs:8:19-27 + (and originally defined in ‘Data.Traversable’) defined at T1972.hs:17:1 T1972.hs:21:10: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)] diff --git a/testsuite/tests/rename/should_compile/T4478.hs b/testsuite/tests/rename/should_compile/T4478.hs index ca6d8e5be0..9e3fcee81a 100644 --- a/testsuite/tests/rename/should_compile/T4478.hs +++ b/testsuite/tests/rename/should_compile/T4478.hs @@ -2,7 +2,7 @@ -- We don't want to warn about duplicate exports for things exported -- by both "module" exports -module T4478 (module Prelude, module Data.Foldable) where +module T4478 (module Prelude, module Data.List) where import Prelude -import Data.Foldable +import Data.List diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 8e55b3705a..536c5b9013 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -168,7 +168,9 @@ test('T15798b', normal, compile, ['']) test('T15798c', normal, compile, ['']) test('T16116a', normal, compile, ['']) test('T15957', normal, compile, ['-Werror -Wredundant-record-wildcards -Wunused-record-wildcards']) +test('T17244A', normal, compile, ['-Wno-error=compat-unqualified-imports']) test('T17244B', normal, compile, ['']) +test('T17244C', normal, compile, ['']) test('T17832', [], multimod_compile, ['T17832M1', 'T17832M2']) test('T17837', normal, compile, ['']) test('T18497', [], makefile_test, ['T18497']) diff --git a/testsuite/tests/rename/should_fail/T17244A.stderr b/testsuite/tests/rename/should_fail/T17244A.stderr deleted file mode 100644 index 6286a71de2..0000000000 --- a/testsuite/tests/rename/should_fail/T17244A.stderr +++ /dev/null @@ -1,10 +0,0 @@ - -T17244A.hs:10:9: error: - Ambiguous occurrence ‘sum’ - It could refer to - either ‘Prelude.sum’, - imported from ‘Prelude’ at T17244A.hs:3:8-14 - (and originally defined in ‘Data.Foldable’) - or ‘Data.List.sum’, - imported from ‘Data.List’ at T17244A.hs:7:1-16 - (and originally defined in ‘GHC.List’) diff --git a/testsuite/tests/rename/should_fail/T17244C.stderr b/testsuite/tests/rename/should_fail/T17244C.stderr deleted file mode 100644 index 71570a01bd..0000000000 --- a/testsuite/tests/rename/should_fail/T17244C.stderr +++ /dev/null @@ -1,10 +0,0 @@ - -T17244C.hs:10:9: error: - Ambiguous occurrence ‘sum’ - It could refer to - either ‘Prelude.sum’, - imported from ‘Prelude’ at T17244C.hs:3:8-14 - (and originally defined in ‘Data.Foldable’) - or ‘Data.List.sum’, - imported from ‘Data.List’ at T17244C.hs:7:19-21 - (and originally defined in ‘GHC.List’) diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index aec42ad733..4ce00de399 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -154,8 +154,6 @@ test('T16385', normal, compile_fail, ['']) test('T16504', normal, compile_fail, ['']) test('T14548', normal, compile_fail, ['']) test('T16610', normal, compile_fail, ['']) -test('T17244A', normal, compile_fail, ['-Wno-error=compat-unqualified-imports']) -test('T17244C', normal, compile_fail, ['']) test('T17593', normal, compile_fail, ['']) test('T18021', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) diff --git a/testsuite/tests/rename/should_fail/rnfail040.stderr b/testsuite/tests/rename/should_fail/rnfail040.stderr index 9cd16615e0..33f2f8cba9 100644 --- a/testsuite/tests/rename/should_fail/rnfail040.stderr +++ b/testsuite/tests/rename/should_fail/rnfail040.stderr @@ -3,6 +3,7 @@ rnfail040.hs:7:12: error: Conflicting exports for ‘nub’: ‘module M’ exports ‘M.nub’ imported from ‘Data.List’ at rnfail040.hs:10:2-22 + (and originally defined in ‘base-4.13.0.0:Data.OldList’) ‘module M’ exports ‘T.nub’ imported from ‘Rnfail040_A’ at rnfail040.hs:11:2-24 (and originally defined at Rnfail040_A.hs:2:3-5) diff --git a/testsuite/tests/simplCore/should_run/T10830.hs b/testsuite/tests/simplCore/should_run/T10830.hs index 3c62171db2..354f0f513a 100644 --- a/testsuite/tests/simplCore/should_run/T10830.hs +++ b/testsuite/tests/simplCore/should_run/T10830.hs @@ -1,3 +1,3 @@ -import Data.List (maximumBy) +import GHC.OldList main :: IO () main = maximumBy compare [1..10000] `seq` return () diff --git a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr index 7f9b3e6464..a081a78582 100644 --- a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr +++ b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr @@ -8,10 +8,10 @@ subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)] Valid hole fits include lines :: String -> [String] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 - (and originally defined in ‘Data.List’)) + (and originally defined in ‘base-4.16.0.0:Data.OldList’)) words :: String -> [String] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 - (and originally defined in ‘Data.List’)) + (and originally defined in ‘base-4.16.0.0:Data.OldList’)) read :: forall a. Read a => String -> a with read @[String] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 |