diff options
Diffstat (limited to 'testsuite')
8 files changed, 176 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_compile/T23307.hs b/testsuite/tests/simplCore/should_compile/T23307.hs new file mode 100644 index 0000000000..3cc6f676ad --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23307.hs @@ -0,0 +1,5 @@ +module T23307 where + +data Stream a = Nil | Cons a !(Stream a) +data Unconsed a = Unconsed a !(Stream a) +data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) diff --git a/testsuite/tests/simplCore/should_compile/T23307.stderr b/testsuite/tests/simplCore/should_compile/T23307.stderr new file mode 100644 index 0000000000..f42016e9a8 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23307.stderr @@ -0,0 +1,72 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 29, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307.$WYes [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> MUnconsed a +[GblId[DataConWrapper], + Arity=1, + Str=<SL>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307.Yes @a unbx unbx1 + }}] +T23307.$WYes + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307.Yes @a unbx unbx1 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307.$WUnconsed [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> Stream a %1 -> Unconsed a +[GblId[DataConWrapper], + Arity=2, + Str=<L><SL>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Unconsed @a conrep conrep2 + }}] +T23307.$WUnconsed + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Unconsed @a conrep conrep2 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307.$WCons [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> Stream a %1 -> Stream a +[GblId[DataConWrapper], + Arity=2, + Str=<L><SL>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Cons @a conrep conrep2 + }}] +T23307.$WCons + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Cons @a conrep conrep2 + } + + + diff --git a/testsuite/tests/simplCore/should_compile/T23307a.hs b/testsuite/tests/simplCore/should_compile/T23307a.hs new file mode 100644 index 0000000000..f02fee86b4 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23307a.hs @@ -0,0 +1,7 @@ +module T23307a where + +data List a = Nil | Cons {-# UNPACK #-} !(Unconsed a) + -- This UNPACK should work + +data Unconsed a = Unconsed a !(List a) +data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a)
\ No newline at end of file diff --git a/testsuite/tests/simplCore/should_compile/T23307a.stderr b/testsuite/tests/simplCore/should_compile/T23307a.stderr new file mode 100644 index 0000000000..415edf23f9 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23307a.stderr @@ -0,0 +1,68 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 28, types: 41, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307a.$WYes [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> MUnconsed a +[GblId[DataConWrapper], + Arity=1, + Str=<SL>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Yes @a unbx unbx1 + }}] +T23307a.$WYes + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Yes @a unbx unbx1 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307a.$WUnconsed [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> List a %1 -> Unconsed a +[GblId[DataConWrapper], + Arity=2, + Str=<L><SL>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: List a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307a.Unconsed @a conrep conrep2 + }}] +T23307a.$WUnconsed + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: List a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307a.Unconsed @a conrep conrep2 + } + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307a.$WCons [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> List a +[GblId[DataConWrapper], + Arity=1, + Str=<SL>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Cons @a unbx unbx1 + }}] +T23307a.$WCons + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Cons @a unbx unbx1 + } + + + diff --git a/testsuite/tests/simplCore/should_compile/T23307b.hs b/testsuite/tests/simplCore/should_compile/T23307b.hs new file mode 100644 index 0000000000..bde4f4da7e --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23307b.hs @@ -0,0 +1,7 @@ +module Foo where + +-- It's easy to get an infinite loop +-- when deciding what to unbox here. + +data T = MkT !S Int +data S = MkS !T
\ No newline at end of file diff --git a/testsuite/tests/simplCore/should_compile/T23307c.hs b/testsuite/tests/simplCore/should_compile/T23307c.hs new file mode 100644 index 0000000000..a0d4de1cfa --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23307c.hs @@ -0,0 +1,7 @@ +module Foo where + +newtype Identity x = MkId x +newtype Fix f = MkFix (f (Fix f)) + +-- This test just checks that the compiler itself doesn't loop +data Loop = LCon {-# UNPACK #-} !(Fix Identity) diff --git a/testsuite/tests/simplCore/should_compile/T23307c.stderr b/testsuite/tests/simplCore/should_compile/T23307c.stderr new file mode 100644 index 0000000000..b55b886583 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T23307c.stderr @@ -0,0 +1,5 @@ + +T23307c.hs:7:13: warning: [GHC-40091] + • Ignoring unusable UNPACK pragma on the first argument of ‘LCon’ + • In the definition of data constructor ‘LCon’ + In the data type declaration for ‘Loop’ diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index a472aa05d9..b1ec7473ff 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -479,3 +479,8 @@ test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script']) test('T23362', normal, compile, ['-O']) +test('T23307', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T23307b', normal, compile, ['-O']) +test('T23307c', normal, compile, ['-O']) + |