Commit f7f567d5 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Ben Gamari
Browse files

Add a test for #14815:

Because the program doesn't have any binders that -XStrict can make
strict, the desugarer output should be identical when it's compiled with
and without -XStrict. This wasn't the case with GHC 8.2.2, but
apparently it was fixed some time between 8.2.2 and 8.4.1. We now add a
test case to make sure it stays fixed.

Reviewers: bgamari

Reviewed By: bgamari

Subscribers: simonpj, rwbarton, thomie, carter

GHC Trac Issues: #14815

Differential Revision: https://phabricator.haskell.org/D4531
parent 48b88421
......@@ -5,12 +5,21 @@ include $(TOP)/mk/test.mk
T5252:
$(RM) -f T5252.hi T5252.o
$(RM) -f T5252a.hi T5252a.o
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5252a.hs
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5252a.hs
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5252.hs
# Failed when compiled *without* optimisation
T5252Take2:
$(RM) -f T5252Take2.hi T5252Take2.o
$(RM) -f T5252Take2a.hi T5252Take2a.o
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5252Take2a.hs
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5252Take2a.hs
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5252Take2.hs
T14815:
'$(TEST_HC)' $(TEST_HC_OPTS) T14815.hs -ddump-ds -dsuppress-uniques -ddump-to-file -dumpdir lazy -fforce-recomp
'$(TEST_HC)' $(TEST_HC_OPTS) T14815.hs -XStrict -ddump-ds -dsuppress-uniques -ddump-to-file -dumpdir strict -fforce-recomp
# Drop time stamps from both files
tail -n +5 lazy/T14815.dump-ds >lazy_out
tail -n +5 strict/T14815.dump-ds >strict_out
# Finally compare outputs
diff lazy_out strict_out -q
-- Desugarer outputs of this program when compiled with and without -XStrict
-- should be the same because this program has only one binder (`a` in function
-- `primitive`), but the binder is annotated with a laziness annotation, so
-- -XStrict should have no effect on that binder.
--
-- Derived methods are also effected by -XStrict, but in our case we derive via
-- GND which just generates coercions like
--
-- instance Functor m => Functor (StateT s m) where
-- fmap
-- = coerce
-- @(forall (a_aJ2 :: TYPE LiftedRep) (b_aJ3 :: TYPE LiftedRep).
-- a_aJ2 -> b_aJ3
-- -> StateT s_aDW m_aDX a_aJ2 -> StateT s_aDW m_aDX b_aJ3)
-- @(forall (a_aJ2 :: TYPE LiftedRep) (b_aJ3 :: TYPE LiftedRep).
-- a_aJ2 -> b_aJ3
-- -> StateT s_aDW m_aDX a_aJ2 -> StateT s_aDW m_aDX b_aJ3)
-- fmap
--
-- So really -XStrict shouldn't have any effect on this program.
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
module K where
import qualified Control.Monad.State.Strict as S
import Control.Monad.Trans
import GHC.Exts
class Monad m => PrimMonad m where
type PrimState m
primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
newtype StateT s m a = StateT (S.StateT s m a)
deriving (Functor, Applicative, Monad, MonadTrans)
instance PrimMonad m => PrimMonad (StateT s m) where
type PrimState (StateT s m) = PrimState m
primitive ~a = lift (primitive a) ; {-# INLINE primitive #-}
[1 of 1] Compiling K ( T14815.hs, T14815.o )
[1 of 1] Compiling K ( T14815.hs, T14815.o )
......@@ -102,3 +102,4 @@ test('T13870', normal, compile, [''])
test('T14135', normal, compile, [''])
test('T14773a', normal, compile, ['-Wincomplete-patterns'])
test('T14773b', normal, compile, ['-Wincomplete-patterns'])
test('T14815', [], run_command, ['$MAKE -s --no-print-directory T14815'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment