diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2022-08-22 16:05:31 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-09-05 23:12:14 -0400 |
commit | d2be80fd9b222963e8dd09a30f78c106e00da7f9 (patch) | |
tree | fc6c4c14dbe301659367dbbbefe65a60442b256b /testsuite/tests | |
parent | 7f527f01c8b4b61047fa87905750ee962f527e36 (diff) | |
download | haskell-d2be80fd9b222963e8dd09a30f78c106e00da7f9.tar.gz |
DmdAnal: Don't panic in addCaseBndrDmd (#22039)
Rather conservatively return Top.
See Note [Untyped demand on case-alternative binders].
I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and
`fieldBndrDmds`.
Fixes #22039.
Diffstat (limited to 'testsuite/tests')
-rw-r--r-- | testsuite/tests/stranal/should_compile/T22039.hs | 59 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_compile/all.T | 1 |
2 files changed, 60 insertions, 0 deletions
diff --git a/testsuite/tests/stranal/should_compile/T22039.hs b/testsuite/tests/stranal/should_compile/T22039.hs new file mode 100644 index 0000000000..034be06cae --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T22039.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE ExistentialQuantification #-} + +module Bug where + +import Control.Exception +import Data.Typeable +import Unsafe.Coerce + +data Error + = Error Int String + | forall e . Exception e => SomeError Int e + deriving (Typeable) + +fromError :: Exception e => Error -> Maybe e +fromError e@(Error _ _) = cast e +fromError (SomeError _ e) = cast e +-- {-# NOINLINE fromError #-} + +instance Eq Error where + Error i s == Error i' s' = i == i' && s == s' + SomeError i e == SomeError i' e' = i == i' && show e == show e' + _ == _ = False + +instance Show Error where + show _ = "" + +instance Exception Error + +-- newtype +data + UniquenessError = UniquenessError [((String, String), Int)] + deriving (Show, Eq) + +instance Exception UniquenessError + +test :: SomeException -> IO () +test e = case fromError =<< fromException e :: Maybe UniquenessError of + Just err -> print err + _ -> pure () + +-- +-- Smaller reproducer by sgraf +-- + +blarg :: (Int,Int) -> Int +blarg (x,y) = x+y +{-# NOINLINE blarg #-} + +f :: Either Int Int -> Int +f Left{} = 0 +f e = blarg (unsafeCoerce e) + +blurg :: (Int -> Int) -> Int +blurg f = f 42 +{-# NOINLINE blurg #-} + +g :: Either Int Int -> Int +g Left{} = 0 +g e = blurg (unsafeCoerce e) diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index 02428987fc..6dd65a9fcb 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -85,3 +85,4 @@ test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl']) test('T21265', normal, compile, ['']) test('EtaExpansion', normal, compile, ['']) +test('T22039', normal, compile, ['']) |