diff options
Diffstat (limited to 'testsuite/tests/th')
22 files changed, 216 insertions, 30 deletions
diff --git a/testsuite/tests/th/T10697_decided_1.hs b/testsuite/tests/th/T10697_decided_1.hs new file mode 100644 index 0000000000..241cec3d38 --- /dev/null +++ b/testsuite/tests/th/T10697_decided_1.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Language.Haskell.TH + +data T = T {-# UNPACK #-} !Int !Int Int + +$(return []) + +main :: IO () +main = putStrLn $(reifyConStrictness 'T >>= stringE . show) diff --git a/testsuite/tests/th/T10697_decided_1.stdout b/testsuite/tests/th/T10697_decided_1.stdout new file mode 100644 index 0000000000..b0dd4a284a --- /dev/null +++ b/testsuite/tests/th/T10697_decided_1.stdout @@ -0,0 +1 @@ +[DecidedStrict,DecidedStrict,DecidedLazy] diff --git a/testsuite/tests/th/T10697_decided_2.hs b/testsuite/tests/th/T10697_decided_2.hs new file mode 100644 index 0000000000..241cec3d38 --- /dev/null +++ b/testsuite/tests/th/T10697_decided_2.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Language.Haskell.TH + +data T = T {-# UNPACK #-} !Int !Int Int + +$(return []) + +main :: IO () +main = putStrLn $(reifyConStrictness 'T >>= stringE . show) diff --git a/testsuite/tests/th/T10697_decided_2.stdout b/testsuite/tests/th/T10697_decided_2.stdout new file mode 100644 index 0000000000..c4cfc4ab79 --- /dev/null +++ b/testsuite/tests/th/T10697_decided_2.stdout @@ -0,0 +1 @@ +[DecidedStrict,DecidedStrict,DecidedStrict] diff --git a/testsuite/tests/th/T10697_decided_3.hs b/testsuite/tests/th/T10697_decided_3.hs new file mode 100644 index 0000000000..241cec3d38 --- /dev/null +++ b/testsuite/tests/th/T10697_decided_3.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Language.Haskell.TH + +data T = T {-# UNPACK #-} !Int !Int Int + +$(return []) + +main :: IO () +main = putStrLn $(reifyConStrictness 'T >>= stringE . show) diff --git a/testsuite/tests/th/T10697_decided_3.stdout b/testsuite/tests/th/T10697_decided_3.stdout new file mode 100644 index 0000000000..ae59571a61 --- /dev/null +++ b/testsuite/tests/th/T10697_decided_3.stdout @@ -0,0 +1 @@ +[DecidedUnpack,DecidedUnpack,DecidedUnpack] diff --git a/testsuite/tests/th/T10697_source.hs b/testsuite/tests/th/T10697_source.hs new file mode 100644 index 0000000000..4dfa410168 --- /dev/null +++ b/testsuite/tests/th/T10697_source.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE StrictData, TemplateHaskell #-} +module Main where + +import Language.Haskell.TH +import T10697_sourceUtil + +$([d|data A1 = A1 Int {- No unpackedness, no strictness -}|]) +$([d|data A2 = A2 !Int {- No unpackedness, strict -}|]) +$([d|data A3 = A3 ~Int {- No unpackedness, lazy -}|]) +$([d|data A4 = A4 {-# NOUNPACK #-} Int {- NOUNPACK, no strictness -}|]) +$([d|data A5 = A5 {-# NOUNPACK #-} !Int {- NOUNPACK, strict -}|]) +$([d|data A6 = A6 {-# NOUNPACK #-} ~Int {- NOUNPACK, lazy -}|]) +$([d|data A7 = A7 {-# UNPACK #-} Int {- UNPACK, no strictness -}|]) +$([d|data A8 = A8 {-# UNPACK #-} !Int {- UNPACK, strict -}|]) +$([d|data A9 = A9 {-# UNPACK #-} ~Int {- UNPACK, lazy -}|]) + +$(do b1 <- newName "B1" + b2 <- newName "B2" + b3 <- newName "B3" + b4 <- newName "B4" + b5 <- newName "B5" + b6 <- newName "B6" + b7 <- newName "B7" + b8 <- newName "B8" + b9 <- newName "B9" + c1 <- newName "C1" + c2 <- newName "C2" + c3 <- newName "C3" + c4 <- newName "C4" + c5 <- newName "C5" + c6 <- newName "C6" + c7 <- newName "C7" + c8 <- newName "C8" + c9 <- newName "C9" + + d1 <- makeSimpleDatatype b1 c1 noSourceUnpackedness noSourceStrictness + d2 <- makeSimpleDatatype b2 c2 noSourceUnpackedness sourceStrict + d3 <- makeSimpleDatatype b3 c3 noSourceUnpackedness sourceLazy + d4 <- makeSimpleDatatype b4 c4 sourceNoUnpack noSourceStrictness + d5 <- makeSimpleDatatype b5 c5 sourceNoUnpack sourceStrict + d6 <- makeSimpleDatatype b6 c6 sourceNoUnpack sourceLazy + d7 <- makeSimpleDatatype b7 c7 sourceUnpack noSourceStrictness + d8 <- makeSimpleDatatype b8 c8 sourceUnpack sourceStrict + d9 <- makeSimpleDatatype b9 c9 sourceUnpack sourceLazy + return [d1, d2, d3, d4, d5, d6, d7, d8, d9]) + +main :: IO () +main = mapM_ print [ $(checkBang ''E1 noSourceUnpackedness noSourceStrictness) + , $(checkBang ''E2 noSourceUnpackedness sourceStrict) + , $(checkBang ''E3 noSourceUnpackedness sourceLazy) + , $(checkBang ''E4 sourceNoUnpack noSourceStrictness) + , $(checkBang ''E5 sourceNoUnpack sourceStrict) + , $(checkBang ''E6 sourceNoUnpack sourceLazy) + , $(checkBang ''E7 sourceUnpack noSourceStrictness) + , $(checkBang ''E8 sourceUnpack sourceStrict) + , $(checkBang ''E9 sourceUnpack sourceLazy) + ] diff --git a/testsuite/tests/th/T10697_source.stdout b/testsuite/tests/th/T10697_source.stdout new file mode 100644 index 0000000000..c4dc445159 --- /dev/null +++ b/testsuite/tests/th/T10697_source.stdout @@ -0,0 +1,9 @@ +True +True +True +True +True +True +True +True +True diff --git a/testsuite/tests/th/T10697_sourceUtil.hs b/testsuite/tests/th/T10697_sourceUtil.hs new file mode 100644 index 0000000000..048a422b99 --- /dev/null +++ b/testsuite/tests/th/T10697_sourceUtil.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE StrictData, TemplateHaskell #-} +module T10697_sourceUtil where + +import Language.Haskell.TH + +makeSimpleDatatype :: Name + -> Name + -> SourceUnpackednessQ + -> SourceStrictnessQ + -> Q Dec +makeSimpleDatatype tyName conName srcUpk srcStr = + dataD (cxt []) tyName [] Nothing [normalC conName + [bangType (bang srcUpk srcStr) (conT ''Int)]] (cxt []) + +checkBang :: Name + -> SourceUnpackednessQ + -> SourceStrictnessQ + -> ExpQ +checkBang n srcUpk1 srcStr1 = do + TyConI (DataD _ _ _ _ [NormalC _ [(Bang srcUpk2 srcStr2, _)]] _) <- reify n + srcUpk1' <- srcUpk1 + srcStr1' <- srcStr1 + if srcUpk1' == srcUpk2 && srcStr1' == srcStr2 + then [| True |] + else [| False |] + +data E1 = E1 Int -- No unpackedness, no strictness +data E2 = E2 !Int -- No unpackedness, strict +data E3 = E3 ~Int -- No unpackedness, lazy +data E4 = E4 {-# NOUNPACK #-} Int -- NOUNPACK, no strictness +data E5 = E5 {-# NOUNPACK #-} !Int -- NOUNPACK, strict +data E6 = E6 {-# NOUNPACK #-} ~Int -- NOUNPACK, lazy +data E7 = E7 {-# UNPACK #-} Int -- UNPACK, no strictness +data E8 = E8 {-# UNPACK #-} !Int -- UNPACK, strict +data E9 = E9 {-# UNPACK #-} ~Int -- UNPACK, lazy diff --git a/testsuite/tests/th/T10819_Lib.hs b/testsuite/tests/th/T10819_Lib.hs index 94f352efe7..2be00b4a51 100644 --- a/testsuite/tests/th/T10819_Lib.hs +++ b/testsuite/tests/th/T10819_Lib.hs @@ -2,6 +2,6 @@ module T10819_Lib where import Language.Haskell.TH.Syntax -doSomeTH s tp drv = return [NewtypeD [] n [] Nothing - (NormalC n [(NotStrict, ConT tp)]) drv] +doSomeTH s tp drv = return [NewtypeD [] n [] Nothing (NormalC n + [(Bang NoSourceUnpackedness NoSourceStrictness, ConT tp)]) drv] where n = mkName s diff --git a/testsuite/tests/th/T10828.hs b/testsuite/tests/th/T10828.hs index f01c5b9769..75b852ff07 100644 --- a/testsuite/tests/th/T10828.hs +++ b/testsuite/tests/th/T10828.hs @@ -33,16 +33,28 @@ $( return [ PlainTV (mkName "a") ] (Just StarT) [ GadtC [(mkName "MkT")] - [ (NotStrict, VarT (mkName "a")) - , (NotStrict, VarT (mkName "a"))] + [ ( Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "a") + ) + , ( Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "a") + ) + ] ( mkName "T" ) [ VarT (mkName "a") ] , ForallC [PlainTV (mkName "a"), PlainTV (mkName "b")] [AppT (AppT EqualityT (VarT $ mkName "a" ) ) (ConT $ mkName "Int") ] $ RecGadtC [(mkName "MkC")] - [ (mkName "foo", NotStrict, VarT (mkName "a")) - , (mkName "bar", NotStrict, VarT (mkName "b"))] + [ ( mkName "foo" + , Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "a") + ) + , ( mkName "bar" + , Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "b") + ) + ] ( mkName "T" ) [ ConT (mkName "Int") ] ] [] ]) diff --git a/testsuite/tests/th/T10828a.hs b/testsuite/tests/th/T10828a.hs index 8bf13cfb04..c3108c3e38 100644 --- a/testsuite/tests/th/T10828a.hs +++ b/testsuite/tests/th/T10828a.hs @@ -11,7 +11,12 @@ $( return [ PlainTV (mkName "a") ] (Just StarT) [ NormalC (mkName "MkT") - [ (NotStrict, VarT (mkName "a")) - , (NotStrict, VarT (mkName "a"))] + [ ( Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "a") + ) + , ( Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "a") + ) + ] ] [] ]) diff --git a/testsuite/tests/th/T10828b.hs b/testsuite/tests/th/T10828b.hs index 55d8889009..ac4f6a28e5 100644 --- a/testsuite/tests/th/T10828b.hs +++ b/testsuite/tests/th/T10828b.hs @@ -10,16 +10,30 @@ $( return [ DataD [] (mkName "T") [ PlainTV (mkName "a") ] (Just StarT) - [ NormalC (mkName "MkT") - [ (NotStrict, VarT (mkName "a")) - , (NotStrict, VarT (mkName "a"))] + [ NormalC + (mkName "MkT") + [ ( Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "a") + ) + , ( Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "a") + ) + ] , ForallC [PlainTV (mkName "a")] [AppT (AppT EqualityT (VarT $ mkName "a" ) ) (ConT $ mkName "Int") ] $ - RecGadtC [(mkName "MkC")] - [ (mkName "foo", NotStrict, VarT (mkName "a")) - , (mkName "bar", NotStrict, VarT (mkName "b"))] - ( mkName "T" ) - [ ConT (mkName "Int") ] + RecGadtC + [ (mkName "MkC")] + [ ( mkName "foo" + , Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "a") + ) + , ( mkName "bar" + , Bang NoSourceUnpackedness NoSourceStrictness + , VarT (mkName "b") + ) + ] + ( mkName "T" ) + [ ConT (mkName "Int") ] ] [] ]) diff --git a/testsuite/tests/th/T5290.hs b/testsuite/tests/th/T5290.hs index 50ad2d500c..2215ef1075 100644 --- a/testsuite/tests/th/T5290.hs +++ b/testsuite/tests/th/T5290.hs @@ -5,4 +5,5 @@ module T5290 where import Language.Haskell.TH $( let n = mkName "T" - in return [DataD [] n [] Nothing [NormalC n [(Unpacked,ConT ''Int)]] []] ) + in return [DataD [] n [] Nothing + [NormalC n [(Bang SourceUnpack SourceStrict,ConT ''Int)]] []] ) diff --git a/testsuite/tests/th/T5290.stderr b/testsuite/tests/th/T5290.stderr index d6996d0799..19c962a9a0 100644 --- a/testsuite/tests/th/T5290.stderr +++ b/testsuite/tests/th/T5290.stderr @@ -1,7 +1,13 @@ -T5290.hs:(7,4)-(8,75): Splicing declarations +T5290.hs:(7,4)-(9,77): Splicing declarations let n = mkName "T" in return - [DataD [] n [] Nothing [NormalC n [(Unpacked, ConT ''Int)]] []] + [DataD + [] + n + [] + Nothing + [NormalC n [(Bang SourceUnpack SourceStrict, ConT ''Int)]] + []] ======> data T = T {-# UNPACK #-} !Int diff --git a/testsuite/tests/th/T5665a.hs b/testsuite/tests/th/T5665a.hs index b34131e974..2b558271b3 100644 --- a/testsuite/tests/th/T5665a.hs +++ b/testsuite/tests/th/T5665a.hs @@ -2,6 +2,6 @@ module T5665a where import Language.Haskell.TH -doSomeTH s tp = return [NewtypeD [] n [] Nothing - (NormalC n [(NotStrict, ConT tp)]) []] +doSomeTH s tp = return [NewtypeD [] n [] Nothing (NormalC n + [(Bang NoSourceUnpackedness NoSourceStrictness, ConT tp)]) []] where n = mkName s diff --git a/testsuite/tests/th/T5984_Lib.hs b/testsuite/tests/th/T5984_Lib.hs index a929086dd2..d8913cd8f3 100644 --- a/testsuite/tests/th/T5984_Lib.hs +++ b/testsuite/tests/th/T5984_Lib.hs @@ -5,10 +5,11 @@ module T5984_Lib where import Language.Haskell.TH nt :: Q [Dec] -nt = return [NewtypeD [] foo [] Nothing - (NormalC foo [(NotStrict, ConT ''Int)]) []] +nt = return [NewtypeD [] foo [] Nothing (NormalC foo + [(Bang NoSourceUnpackedness NoSourceStrictness, ConT ''Int)]) []] where foo = mkName "Foo" dt :: Q [Dec] -dt = return [DataD [] bar [] Nothing [NormalC bar [(NotStrict, ConT ''Int)]] []] +dt = return [DataD [] bar [] Nothing [NormalC bar + [(Bang NoSourceUnpackedness NoSourceStrictness, ConT ''Int)]] []] where bar = mkName "Bar" diff --git a/testsuite/tests/th/T7532.hs b/testsuite/tests/th/T7532.hs index 3a641ea97a..a7604710f5 100644 --- a/testsuite/tests/th/T7532.hs +++ b/testsuite/tests/th/T7532.hs @@ -8,4 +8,4 @@ import T7532a instance C Bool where data D Bool = MkD -$(bang) +$(bang') diff --git a/testsuite/tests/th/T7532.stderr b/testsuite/tests/th/T7532.stderr index 3e57bb8955..baaf04f3f5 100644 --- a/testsuite/tests/th/T7532.stderr +++ b/testsuite/tests/th/T7532.stderr @@ -3,8 +3,8 @@ instance C Bool where data D Bool = T7532.MkD -T7532.hs:11:3-6: Splicing declarations - bang +T7532.hs:11:3-7: Splicing declarations + bang' ======> instance C Int where data D Int = T diff --git a/testsuite/tests/th/T7532a.hs b/testsuite/tests/th/T7532a.hs index 42976b393c..901e27a1bf 100644 --- a/testsuite/tests/th/T7532a.hs +++ b/testsuite/tests/th/T7532a.hs @@ -8,8 +8,8 @@ import Language.Haskell.TH class C a where data D a -bang :: DecsQ -bang = return [ +bang' :: DecsQ +bang' = return [ InstanceD [] (AppT (ConT ''C) (ConT ''Int)) [ DataInstD [] ''D [ConT ''Int] Nothing [ NormalC (mkName "T") []] []]] diff --git a/testsuite/tests/th/TH_genExLib.hs b/testsuite/tests/th/TH_genExLib.hs index 5e1ee0bfc0..25091c4ecf 100644 --- a/testsuite/tests/th/TH_genExLib.hs +++ b/testsuite/tests/th/TH_genExLib.hs @@ -16,5 +16,6 @@ genAnyClass name decls where anyName = mkName ("Any" ++ nameBase name ++ "1111") constructor = ForallC [PlainTV var_a] [AppT (ConT name) (VarT var_a)] $ - NormalC anyName [(NotStrict, VarT var_a)] + NormalC anyName + [(Bang NoSourceUnpackedness NoSourceStrictness, VarT var_a)] var_a = mkName "a" diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 5a55b6f0da..9d00d8e856 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -358,6 +358,15 @@ test('T10306', normal, compile, ['-v0']) test('T10596', normal, compile, ['-v0']) test('T10620', normal, compile_and_run, ['-v0']) test('T10638', normal, compile_fail, ['-v0']) +test('T10697_decided_1', normal, compile_and_run, ['-v0']) +test('T10697_decided_2', normal, compile_and_run, ['-XStrictData -v0']) +test('T10697_decided_3', normal, + compile_and_run, + ['-XStrictData -funbox-strict-fields -O2 -v0']) +test('T10697_source', + extra_clean(['T10697_sourceUtil.hi', 'T10697_sourceUtil.o']), + multimod_compile_and_run, + ['T10697_source', '-w ' + config.ghc_th_way_flags]) test('T10704', extra_clean(['T10704a.o','T10704a.hi']), multimod_compile_and_run, |