diff options
| author | Sebastian Graf <sebastian.graf@kit.edu> | 2022-05-19 18:37:38 +0200 |
|---|---|---|
| committer | Sebastian Graf <sebastian.graf@kit.edu> | 2022-06-20 09:43:29 +0200 |
| commit | b570da84b7aad5ca3f90f2d1c1a690c927e99fe9 (patch) | |
| tree | 9210e2e9c3f37477db705df57dbf359da9e95baa /testsuite | |
| parent | 94f2e92a2510a3338c5201a4dcc69666fa9575f8 (diff) | |
| download | haskell-b570da84b7aad5ca3f90f2d1c1a690c927e99fe9.tar.gz | |
CorePrep: Don't speculatively evaluate recursive calls (#20836)
In #20836 we have optimised a terminating program into an endless loop,
because we speculated the self-recursive call of a recursive DFun.
Now we track the set of enclosing recursive binders in CorePrep to prevent
speculation of such self-recursive calls.
See the updates to Note [Speculative evaluation] for details.
Fixes #20836.
Diffstat (limited to 'testsuite')
| -rw-r--r-- | testsuite/tests/count-deps/CountDepsAst.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/count-deps/CountDepsParser.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_run/T20836.hs | 23 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_run/all.T | 1 |
4 files changed, 26 insertions, 0 deletions
diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout index 0c7d753be6..75ef4e13de 100644 --- a/testsuite/tests/count-deps/CountDepsAst.stdout +++ b/testsuite/tests/count-deps/CountDepsAst.stdout @@ -76,6 +76,7 @@ GHC.Data.FastString GHC.Data.FastString.Env GHC.Data.FiniteMap GHC.Data.Graph.Directed +GHC.Data.Graph.UnVar GHC.Data.IOEnv GHC.Data.List.SetOps GHC.Data.Maybe diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout index 30267860d8..a4a51fbf9a 100644 --- a/testsuite/tests/count-deps/CountDepsParser.stdout +++ b/testsuite/tests/count-deps/CountDepsParser.stdout @@ -76,6 +76,7 @@ GHC.Data.FastString GHC.Data.FastString.Env GHC.Data.FiniteMap GHC.Data.Graph.Directed +GHC.Data.Graph.UnVar GHC.Data.IOEnv GHC.Data.List.SetOps GHC.Data.Maybe diff --git a/testsuite/tests/simplCore/should_run/T20836.hs b/testsuite/tests/simplCore/should_run/T20836.hs new file mode 100644 index 0000000000..462fdb3ac7 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T20836.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +import Data.Kind (Type) + +class (Monad m, MonadFoo (FooM m)) => MonadFoo m where + type FooM m :: Type -> Type + runFoo :: FooM m a -> m a + +newtype MyMonad m a = MyMonad { runMyMonad :: m a } + deriving (Functor, Applicative, Monad) + +instance Monad m => MonadFoo (MyMonad m) where + type FooM (MyMonad m) = MyMonad m + runFoo = id + +main :: IO () +main = runMyMonad foo + +foo :: MonadFoo m => m () +foo = runFoo $ return () diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 509ae1ff57..bebd839724 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -105,3 +105,4 @@ test('T19313', normal, compile_and_run, ['']) test('UnliftedArgRule', normal, compile_and_run, ['']) test('T21229', normal, compile_and_run, ['-O']) test('T21575', normal, compile_and_run, ['-O']) +test('T20836', normal, compile_and_run, ['-O0']) # Should not time out; See #20836 |