summaryrefslogtreecommitdiff
path: root/testsuite/tests/stranal
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/stranal')
-rw-r--r--testsuite/tests/stranal/should_run/T22549.hs37
-rw-r--r--testsuite/tests/stranal/should_run/T22549.stdout1
-rw-r--r--testsuite/tests/stranal/should_run/all.T2
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'])