diff options
Diffstat (limited to 'testsuite/tests/stranal')
| -rw-r--r-- | testsuite/tests/stranal/should_run/T22549.hs | 37 | ||||
| -rw-r--r-- | testsuite/tests/stranal/should_run/T22549.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/stranal/should_run/all.T | 2 |
3 files changed, 40 insertions, 0 deletions
diff --git a/testsuite/tests/stranal/should_run/T22549.hs b/testsuite/tests/stranal/should_run/T22549.hs new file mode 100644 index 0000000000..841ead007b --- /dev/null +++ b/testsuite/tests/stranal/should_run/T22549.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE DeriveFunctor #-} + +import Data.Function (on) + +newtype Identity a = Identity a deriving (Eq, Functor) +instance Applicative Identity where + pure = Identity + Identity f <*> Identity a = Identity $ f a +instance Monad Identity where + Identity a >>= f = f a + +data ViewT m a + = Empty + | a :< SeqT m a +newtype SeqT m a = SeqT [m (ViewT m a)] + +toViewT :: Monad m => SeqT m a -> m (ViewT m a) +toViewT (SeqT []) = pure Empty +toViewT (SeqT (h : t)) = h >>= \case + Empty -> toViewT (SeqT t) + hi :< SeqT ti -> pure (hi :< SeqT (ti ++ t)) + +instance (Eq (m (ViewT m a)), Monad m) => Eq (SeqT m a) where + (==) = (==) `on` toViewT + +deriving instance (Eq a, Eq (SeqT m a)) => Eq (ViewT m a) + +example :: SeqT Identity Int +example = SeqT [] + +main :: IO () +main = print (example == example) diff --git a/testsuite/tests/stranal/should_run/T22549.stdout b/testsuite/tests/stranal/should_run/T22549.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/stranal/should_run/T22549.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index a2b8e4cfc5..9da7863314 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -30,3 +30,5 @@ test('T19053', normal, compile_and_run, ['']) test('T21717b', normal, compile_and_run, ['']) test('T22475', normal, compile_and_run, ['']) test('T22475b', normal, compile_and_run, ['']) +# T22549: Do not strictify DFuns, otherwise we will <<loop>> +test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise']) |
