diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-07-22 08:37:56 +0000 |
---|---|---|
committer | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-07-22 08:38:07 +0000 |
commit | 86b1522c85519b43ab5c1ce09b61bd8005edfd11 (patch) | |
tree | ab4de778d9cca8290fc150cec472806eefe7b46a /testsuite | |
parent | fb34b27c97515d06bcc00065b352704a5ea21557 (diff) | |
download | haskell-86b1522c85519b43ab5c1ce09b61bd8005edfd11.tar.gz |
Unboxed sums: More unit tests
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/unboxedsums/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs | 69 |
2 files changed, 63 insertions, 8 deletions
diff --git a/testsuite/tests/unboxedsums/all.T b/testsuite/tests/unboxedsums/all.T index 0b948b1477..806f41568e 100644 --- a/testsuite/tests/unboxedsums/all.T +++ b/testsuite/tests/unboxedsums/all.T @@ -1,5 +1,5 @@ test('unboxedsums_unit_tests', - only_ways(['normal']), + [ only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ], compile_and_run, ['-package ghc']) diff --git a/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs b/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs index d7a8d333a0..5c0b929f78 100644 --- a/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs +++ b/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs @@ -1,17 +1,32 @@ module Main where +import BasicTypes +import GHC +import GhcMonad +import Outputable +import RepType +import TysPrim import TysWiredIn import UniqSet import Unique -import System.IO +import qualified Control.Exception as E import Control.Monad +import System.Environment (getArgs) +import System.IO -main :: IO () -main = sequence_ - [ uniq_tests ] +assert :: Bool -> String -> SDoc -> IO () +assert False tn msg = pprPanic tn msg +assert True _ _ = return () +main :: IO () +main = do + [libdir] <- getArgs + runGhc (Just libdir) $ liftIO $ do + -- need to initialize the monad to initialize static flags etc. + sequence_ [ uniq_tests, layout_tests ] +-- Make sure sum datacon/tycon uniques are really uniq uniq_tests :: IO () uniq_tests = do let tycons = map sumTyCon [2 .. 20] @@ -21,6 +36,46 @@ uniq_tests = do us = mkUniqSet (map getUnique tycons) `unionUniqSets` mkUniqSet (map getUnique datacons) - when (sizeUniqSet us /= length tycons + length datacons) $ do - hPutStrLn stderr "Sum cons/tycons have same uniques." - hFlush stderr + assert (sizeUniqSet us == length tycons + length datacons) + "uniq_tests" + (text "Sum cons/tycons have same uniques.") + +layout_tests :: IO () +layout_tests = sequence_ + [ layout1, layout2, layout3, enum_layout ] + where + assert_layout tn tys layout = + let + layout_ret = ubxSumRepType tys + in + assert (layout_ret == layout) + tn + (text "Unexpected sum layout." $$ + text "Alts: " <+> ppr tys $$ + text "Expected layout:" <+> ppr layout $$ + text "Actual layout: " <+> ppr layout_ret) + + ubxtup = mkTupleTy Unboxed + + layout1 = + assert_layout "layout1" + [ ubxtup [ intTy, intPrimTy ] + , ubxtup [ intPrimTy, intTy ] ] + [ WordSlot, PtrSlot, WordSlot ] + + layout2 = + assert_layout "layout2" + [ ubxtup [ intTy ] + , intTy ] + [ WordSlot, PtrSlot ] + + layout3 = + assert_layout "layout3" + [ ubxtup [ intTy, intPrimTy, intTy, intPrimTy ] + , ubxtup [ intPrimTy, intTy, intPrimTy, intTy ] ] + [ WordSlot, PtrSlot, PtrSlot, WordSlot, WordSlot ] + + enum_layout = + assert_layout "enum" + (replicate 10 (ubxtup [])) + [ WordSlot ] |