unboxedsums_unit_tests.hs 2.17 KB
Newer Older
1 2
module Main where

3 4 5 6 7 8
import BasicTypes
import GHC
import GhcMonad
import Outputable
import RepType
import TysPrim
9 10 11 12
import TysWiredIn
import UniqSet
import Unique

13
import qualified Control.Exception as E
14
import Control.Monad
15 16
import System.Environment (getArgs)
import System.IO
17

18 19 20
assert :: Bool -> String -> SDoc -> IO ()
assert False tn msg = pprPanic tn msg
assert True  _  _   = return ()
21

22 23 24 25 26 27
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 ]
28

29
-- Make sure sum datacon/tycon uniques are really uniq
30 31 32 33 34 35 36 37 38
uniq_tests :: IO ()
uniq_tests = do
    let tycons   = map sumTyCon [2 .. 20]
        datacons = [ sumDataCon alt arity | arity <- [ 2 .. 20 ]
                                          , alt   <- [ 1 .. arity ] ]

        us = mkUniqSet (map getUnique tycons)
               `unionUniqSets` mkUniqSet (map getUnique datacons)

39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
    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 ]