[Git][ghc/ghc][wip/T17521] More and better tests

[Jaro Reinders (@Noughtmare)]

Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC


Commits:
63ca8a46 by Jaro Reinders at 2023-07-18T13:04:43+02:00
More and better tests

- - - - -


4 changed files:

- testsuite/tests/unlifted-datatypes/should_compile/TopLevel.hs
- testsuite/tests/unlifted-datatypes/should_compile/TopLevela.hs → testsuite/tests/unlifted-datatypes/should_compile/TopLevelMixBangs.hs
- + testsuite/tests/unlifted-datatypes/should_compile/TopLevelMixBangs.stderr
- testsuite/tests/unlifted-datatypes/should_compile/all.T


Changes:

=====================================
testsuite/tests/unlifted-datatypes/should_compile/TopLevel.hs
=====================================
@@ -1,7 +1,14 @@
-import TopLevela
+{-# OPTIONS_GHC -ddump-simpl -ddump-simpl -dsuppress-all -dno-typeable-binds -dsuppress-uniques #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+module TopLevel where
 
-toInt UZero = 0
-toInt (USucc x) = 1 + toInt x
+import GHC.Exts (UnliftedType)
+import Data.Kind (Type)
 
-main = case x of
-  Box y -> print (toInt y)
+type UNat :: UnliftedType
+data UNat = UZero | USucc UNat
+
+type Box :: UnliftedType -> Type
+data Box a = Box a
+
+x = Box (USucc (USucc (USucc (USucc (USucc UZero)))))


=====================================
testsuite/tests/unlifted-datatypes/should_compile/TopLevela.hs → testsuite/tests/unlifted-datatypes/should_compile/TopLevelMixBangs.hs
=====================================
@@ -1,14 +1,20 @@
 {-# OPTIONS_GHC -ddump-simpl -ddump-simpl -dsuppress-all -dno-typeable-binds -dsuppress-uniques #-}
 {-# LANGUAGE UnliftedDatatypes #-}
-module TopLevela where
+module TopLevelMixBangs where
 
 import GHC.Exts (UnliftedType)
 import Data.Kind (Type)
 
 type UNat :: UnliftedType
-data UNat = UZero | USucc UNat
+data UNat = UZero | USucc !LNat
+
+data LNat = LZero | LSucc UNat
 
 type Box :: UnliftedType -> Type
 data Box a = Box a
 
-x = Box (USucc (USucc (USucc (USucc (USucc UZero)))))
+x = Box (USucc xa)
+xa = LSucc (USucc xb)
+xb = LSucc (USucc xc)
+xc = LSucc (USucc xd)
+xd = LZero


=====================================
testsuite/tests/unlifted-datatypes/should_compile/TopLevelMixBangs.stderr
=====================================
@@ -0,0 +1,28 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 33, types: 15, coercions: 0, joins: 0/0}
+
+$WUSucc
+  = \ conrep -> case conrep of conrep1 { __DEFAULT -> USucc conrep1 }
+
+xd = LZero
+
+xc1 = USucc LZero
+
+xc = LSucc xc1
+
+xb1 = USucc xc
+
+xb = LSucc xb1
+
+xa1 = USucc xb
+
+xa = LSucc xa1
+
+x1 = USucc xa
+
+x = Box x1
+
+
+


=====================================
testsuite/tests/unlifted-datatypes/should_compile/all.T
=====================================
@@ -2,7 +2,8 @@ test('UnlDataMonoSigs', normal, compile, [''])
 test('UnlDataPolySigs', normal, compile, [''])
 test('UnlDataFams', normal, compile, [''])
 test('UnlDataUsersGuide', normal, compile, [''])
-test('TopLevel', normal, multimod_compile, ['TopLevel', '-O -v0'])
+test('TopLevel', normal, compile, ['-O -v0'])
+test('TopLevelMixBangs', normal, compile, ['-O -v0'])
 test('TopLevelStgRewrite', normal, multimod_compile, ['TopLevelStgRewrite', '-v0'])
 test('TopLevelStgRewriteBoot', normal, multimod_compile, ['TopLevelStgRewriteBoot', '-O -v0'])
 test('TopLevelSGraf', normal, compile, ['-O'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63ca8a4683069a84f6177b56c1ac2d78e410f976

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63ca8a4683069a84f6177b56c1ac2d78e410f976
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230718/d9e60925/attachment-0001.html>