diff options
Diffstat (limited to 'testsuite/tests')
42 files changed, 561 insertions, 1 deletions
diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index 7bdbaefd00..45e257e4ec 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -39,7 +39,8 @@ expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", - "TypeFamilyDependencies"] + "TypeFamilyDependencies", + "UnboxedSums"] expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", diff --git a/testsuite/tests/unboxedsums/Makefile b/testsuite/tests/unboxedsums/Makefile new file mode 100644 index 0000000000..ff17bccc51 --- /dev/null +++ b/testsuite/tests/unboxedsums/Makefile @@ -0,0 +1,10 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +.PHONY: sum_api_annots +sum_api_annots: + number=1 ; while [[ $$number -le 11 ]] ; do \ + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" unboxedsums$$number.hs ; \ + ((number = number + 1)) ; \ + done diff --git a/testsuite/tests/unboxedsums/T12375.hs b/testsuite/tests/unboxedsums/T12375.hs new file mode 100644 index 0000000000..62b6094e64 --- /dev/null +++ b/testsuite/tests/unboxedsums/T12375.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE UnboxedTuples #-} + +module Main where + +type Null = (# #) + +{-# NOINLINE showNull #-} +showNull :: Null -> String +showNull (# #) = "(# #)" + +{-# NOINLINE showNullPair #-} +showNullPair :: (# Null, Null #) -> String +showNullPair (# n1, n2 #) = "(# " ++ showNull n1 ++ ", " ++ showNull n2 ++ " #)" + +main :: IO () +main = do + putStrLn (showNullPair (# (# #), (# #) #)) diff --git a/testsuite/tests/unboxedsums/T12375.stdout b/testsuite/tests/unboxedsums/T12375.stdout new file mode 100644 index 0000000000..7cfa66fe07 --- /dev/null +++ b/testsuite/tests/unboxedsums/T12375.stdout @@ -0,0 +1 @@ +(# (# #), (# #) #) diff --git a/testsuite/tests/unboxedsums/all.T b/testsuite/tests/unboxedsums/all.T new file mode 100644 index 0000000000..274045f393 --- /dev/null +++ b/testsuite/tests/unboxedsums/all.T @@ -0,0 +1,25 @@ +test('unarise', omit_ways(['ghci']), compile_and_run, ['']) +test('unboxedsums1', omit_ways(['ghci']), compile_and_run, ['']) +test('unboxedsums2', omit_ways(['ghci']), compile_and_run, ['']) +test('unboxedsums3', omit_ways(['ghci']), compile_and_run, ['']) +test('unboxedsums4', omit_ways(['ghci']), compile_fail, ['']) +test('unboxedsums5', omit_ways(['ghci']), compile, ['']) +test('unboxedsums6', omit_ways(['ghci']), compile_and_run, ['']) +test('unboxedsums7', omit_ways(['ghci']), compile_and_run, ['']) +test('unboxedsums8', omit_ways(['ghci']), compile_and_run, ['']) +test('unboxedsums9', omit_ways(['ghci']), compile_and_run, ['']) +test('unboxedsums10', omit_ways(['ghci']), compile_and_run, ['']) +test('unboxedsums11', omit_ways(['ghci']), compile_and_run, ['']) + +test('ffi1', normal, compile_fail, ['']) +test('thunk', only_ways(['normal']), compile_and_run, ['']) +test('T12375', only_ways(['normal']), compile_and_run, ['']) +test('empty_sum', only_ways(['normal']), compile_and_run, ['']) +test('sum_rr', normal, compile_fail, ['']) + +# TODO: Need to run this in --slow mode only +# test('sum_api_annots', +# [only_ways(['normal']), +# extra_files([ "unboxedsums" + str(i) + ".hs" for i in range(1, 12) ])], +# run_command, +# ['$MAKE -s --no-print-directory sum_api_annots']) diff --git a/testsuite/tests/unboxedsums/empty_sum.hs b/testsuite/tests/unboxedsums/empty_sum.hs new file mode 100644 index 0000000000..7abbfd87a9 --- /dev/null +++ b/testsuite/tests/unboxedsums/empty_sum.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE UnboxedTuples, UnboxedSums, MagicHash #-} + +module Main where + +type Null = (# #) + +{-# NOINLINE showNull #-} +showNull :: Null -> String +showNull (# #) = "(# #)" + +{-# NOINLINE showNullAlt #-} +showNullAlt :: (# Null | Null #) -> String +showNullAlt (# n1 | #) = "(# " ++ showNull n1 ++ " | #)" +showNullAlt (# | n2 #) = "(# | " ++ showNull n2 ++ " #)" + +main :: IO () +main = do + putStrLn (showNull (# #)) + putStrLn (showNullAlt (# (# #) | #)) + putStrLn (showNullAlt (# | (# #) #)) diff --git a/testsuite/tests/unboxedsums/empty_sum.stdout b/testsuite/tests/unboxedsums/empty_sum.stdout new file mode 100644 index 0000000000..7d3a7bf569 --- /dev/null +++ b/testsuite/tests/unboxedsums/empty_sum.stdout @@ -0,0 +1,3 @@ +(# #) +(# (# #) | #) +(# | (# #) #) diff --git a/testsuite/tests/unboxedsums/ffi1.hs b/testsuite/tests/unboxedsums/ffi1.hs new file mode 100644 index 0000000000..e6128e4ff1 --- /dev/null +++ b/testsuite/tests/unboxedsums/ffi1.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-} + +module Lib where + +import GHC.Prim + +-- Can't unboxed tuples and sums to FFI, we should fail appropriately. + +foreign import ccall "f1" f1 :: (# Int | Int #) -> IO Int +foreign import ccall "f2" f2 :: (# (# Int, Int #) | (# Float#, Float# #) #) -> IO Int +foreign import ccall "f3" f3 :: (# (# #) | Void# | (# Int# | String #) #) -> IO Int diff --git a/testsuite/tests/unboxedsums/ffi1.stderr b/testsuite/tests/unboxedsums/ffi1.stderr new file mode 100644 index 0000000000..3a97270d0d --- /dev/null +++ b/testsuite/tests/unboxedsums/ffi1.stderr @@ -0,0 +1,23 @@ + +ffi1.hs:9:1: error: + • Unacceptable argument type in foreign declaration: + ‘(# Int | Int #)’ cannot be marshalled in a foreign call + • When checking declaration: + foreign import ccall safe "static f1" f1 + :: (# Int | Int #) -> IO Int + +ffi1.hs:10:1: error: + • Unacceptable argument type in foreign declaration: + ‘(# (# Int, Int #) | + (# Float#, Float# #) #)’ cannot be marshalled in a foreign call + • When checking declaration: + foreign import ccall safe "static f2" f2 + :: (# (# Int, Int #) | (# Float#, Float# #) #) -> IO Int + +ffi1.hs:11:1: error: + • Unacceptable argument type in foreign declaration: + ‘(# (# #) | Void# | + (# Int# | String #) #)’ cannot be marshalled in a foreign call + • When checking declaration: + foreign import ccall safe "static f3" f3 + :: (# (# #) | Void# | (# Int# | String #) #) -> IO Int diff --git a/testsuite/tests/unboxedsums/module/Lib.hs b/testsuite/tests/unboxedsums/module/Lib.hs new file mode 100644 index 0000000000..569da49b7f --- /dev/null +++ b/testsuite/tests/unboxedsums/module/Lib.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE UnboxedSums, MagicHash #-} + +module Lib (flip, getInt) where + +import GHC.Exts +import Prelude (Int) + +{-# NOINLINE flip #-} +flip :: (# Int | Int# #) -> (# Int# | Int #) +flip (# i | #) = (# | i #) +flip (# | i #) = (# i | #) + +{-# NOINLINE getInt #-} +getInt :: (# Int# | Int #) -> Int +getInt (# i | #) = I# i +getInt (# | i #) = i diff --git a/testsuite/tests/unboxedsums/module/Main.hs b/testsuite/tests/unboxedsums/module/Main.hs new file mode 100644 index 0000000000..6940dee8b1 --- /dev/null +++ b/testsuite/tests/unboxedsums/module/Main.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE UnboxedSums #-} + +module Main where + +import Lib + +import Prelude (print, IO) + +main :: IO () +main = do + print (getInt (flip (# 123 | #))) diff --git a/testsuite/tests/unboxedsums/module/Makefile b/testsuite/tests/unboxedsums/module/Makefile new file mode 100644 index 0000000000..2c955459c3 --- /dev/null +++ b/testsuite/tests/unboxedsums/module/Makefile @@ -0,0 +1,16 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean: + rm -f *.o + rm -f *.hi + rm -f Main + +main: + rm -f *.o + rm -f *.hi + rm -f Main + '$(TEST_HC)' $(TEST_HC_OPTS) -c Lib.hs + '$(TEST_HC)' $(TEST_HC_OPTS) Main.hs + ./Main diff --git a/testsuite/tests/unboxedsums/module/all.T b/testsuite/tests/unboxedsums/module/all.T new file mode 100644 index 0000000000..fe76aac11d --- /dev/null +++ b/testsuite/tests/unboxedsums/module/all.T @@ -0,0 +1,4 @@ +test('sum_mod', + [normalise_slashes, clean_cmd('$MAKE -s clean'), extra_files(['Lib.hs', 'Main.hs'])], + run_command, + ['$MAKE -s main --no-print-director']) diff --git a/testsuite/tests/unboxedsums/module/sum_mod.stdout b/testsuite/tests/unboxedsums/module/sum_mod.stdout new file mode 100644 index 0000000000..615266b7f6 --- /dev/null +++ b/testsuite/tests/unboxedsums/module/sum_mod.stdout @@ -0,0 +1,3 @@ +[2 of 2] Compiling Main ( Main.hs, Main.o ) +Linking Main ... +123 diff --git a/testsuite/tests/unboxedsums/sum_rr.hs b/testsuite/tests/unboxedsums/sum_rr.hs new file mode 100644 index 0000000000..287edcf452 --- /dev/null +++ b/testsuite/tests/unboxedsums/sum_rr.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds, KindSignatures #-} + +module Example where + +import Data.Typeable +import GHC.Exts + +data Wat (a :: TYPE 'UnboxedSumRep) = Wat a diff --git a/testsuite/tests/unboxedsums/sum_rr.stderr b/testsuite/tests/unboxedsums/sum_rr.stderr new file mode 100644 index 0000000000..2ac9b7452f --- /dev/null +++ b/testsuite/tests/unboxedsums/sum_rr.stderr @@ -0,0 +1,7 @@ + +sum_rr.hs:8:39: error: + • The type ‘a’ is not an unboxed sum, + and yet its kind suggests that it has the representation + of an unboxed sum. This is not allowed. + • In the definition of data constructor ‘Wat’ + In the data type declaration for ‘Wat’ diff --git a/testsuite/tests/unboxedsums/thunk.hs b/testsuite/tests/unboxedsums/thunk.hs new file mode 100644 index 0000000000..53e941d174 --- /dev/null +++ b/testsuite/tests/unboxedsums/thunk.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE UnboxedTuples #-} + +{-# NOINLINE f #-} +f :: (# #) -> [Int] +f (# #) = [ 1 .. ] + +main :: IO () +main = print (sum (take 10 (f (# #)))) diff --git a/testsuite/tests/unboxedsums/thunk.stdout b/testsuite/tests/unboxedsums/thunk.stdout new file mode 100644 index 0000000000..c3f407c095 --- /dev/null +++ b/testsuite/tests/unboxedsums/thunk.stdout @@ -0,0 +1 @@ +55 diff --git a/testsuite/tests/unboxedsums/unarise.hs b/testsuite/tests/unboxedsums/unarise.hs new file mode 100644 index 0000000000..9cdabc4021 --- /dev/null +++ b/testsuite/tests/unboxedsums/unarise.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE UnboxedTuples #-} + +module Main where + +{-# NOINLINE f1 #-} +f1 :: (# #) -> (# #) -> String +f1 (# #) (# #) = "o" + +{-# NOINLINE f2 #-} +f2 :: (# (# #), (# #) #) -> String +f2 (# (# #), (# #) #) = "k" + +main :: IO () +main = do + let t = (# (# #), (# #) #) + case t of + (# t1, t2 #) -> putStrLn (f1 t1 t2 ++ f2 t) diff --git a/testsuite/tests/unboxedsums/unarise.stdout b/testsuite/tests/unboxedsums/unarise.stdout new file mode 100644 index 0000000000..9766475a41 --- /dev/null +++ b/testsuite/tests/unboxedsums/unarise.stdout @@ -0,0 +1 @@ +ok diff --git a/testsuite/tests/unboxedsums/unboxedsums1.hs b/testsuite/tests/unboxedsums/unboxedsums1.hs new file mode 100644 index 0000000000..42a04ae94e --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums1.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE UnboxedSums, MagicHash #-} + +module Main where + +import GHC.Prim +import GHC.Types + +import System.Mem (performMajorGC) + +type Either1 a b = (# a | b #) + +showEither1 :: (Show a, Show b) => Either1 a b -> String +showEither1 (# left | #) = "Left " ++ show left +showEither1 (# | right #) = "Right " ++ show right + +showEither2 :: (# Int# | Float# #) -> String +showEither2 (# i | #) = "Left " ++ show (I# i) +showEither2 (# | f #) = "Right " ++ show (F# f) + +showEither3 :: Show a => (# a | Int# #) -> String +showEither3 (# a | #) = "Left " ++ show a +showEither3 (# | i #) = "Right " ++ show (I# i) + +type T = (# Int | Bool | String | Char | Either Int Bool | Int# | Float# #) + +showEither4 :: T -> String +showEither4 (# i | | | | | | #) = "Alt0: " ++ show i +showEither4 (# | b | | | | | #) = "Alt1: " ++ show b +showEither4 (# | | s | | | | #) = "Alt2: " ++ show s +showEither4 (# | | | c | | | #) = "Alt3: " ++ show c +showEither4 (# | | | | e | | #) = "Alt4: " ++ show e +showEither4 (# | | | | | i | #) = "Alt5: " ++ show (I# i) +showEither4 (# | | | | | | f #) = "Alt6: " ++ show (F# f) + +main :: IO () +main = do + putStrLn (showEither1 e1_1) + putStrLn (showEither1 e1_2) + putStrLn (showEither2 e2_1) + putStrLn (showEither2 e2_2) + putStrLn (showEither3 e3_1) + putStrLn (showEither3 e3_2) + + putStrLn (showEither4 e4_1) + putStrLn (showEither4 e4_2) + putStrLn (showEither4 e4_3) + putStrLn (showEither4 e4_4) + putStrLn (showEither4 e4_5) + putStrLn (showEither4 e4_6) + putStrLn (showEither4 e4_7) + + -- make sure we don't put pointers to non-pointer slots + performMajorGC + + -- make sure pointers in unboxed sums are really roots + putStrLn (showEither1 e1_1) + where + -- boxed types only + e1_1, e1_2 :: Either1 String Int + e1_1 = (# "error" | #) + e1_2 = (# | 10 #) + + -- prim types only + e2_1, e2_2 :: (# Int# | Float# #) + e2_1 = (# 10# | #) + e2_2 = (# | 1.2# #) + + -- a mix of prim and boxed types + e3_1, e3_2 :: (# String | Int# #) + e3_1 = (# "OK" | #) + e3_2 = (# | 123# #) + + -- big arity + e4_1, e4_2, e4_3, e4_4, e4_5, e4_6, e4_7 :: T + e4_1 = (# 10 | | | | | | #) + e4_2 = (# | False | | | | | #) + e4_3 = (# | | "ok" | | | | #) + e4_4 = (# | | | 'a' | | | #) + e4_5 = (# | | | | Right True | | #) + e4_6 = (# | | | | | 123# | #) + e4_7 = (# | | | | | | 54.3# #) diff --git a/testsuite/tests/unboxedsums/unboxedsums1.stdout b/testsuite/tests/unboxedsums/unboxedsums1.stdout new file mode 100644 index 0000000000..3dba0a0685 --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums1.stdout @@ -0,0 +1,14 @@ +Left "error" +Right 10 +Left 10 +Right 1.2 +Left "OK" +Right 123 +Alt0: 10 +Alt1: False +Alt2: "ok" +Alt3: 'a' +Alt4: Right True +Alt5: 123 +Alt6: 54.3 +Left "error" diff --git a/testsuite/tests/unboxedsums/unboxedsums10.hs b/testsuite/tests/unboxedsums/unboxedsums10.hs new file mode 100644 index 0000000000..00f5e548fa --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums10.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE UnboxedSums, MagicHash #-} + +module Main where + +type Ty = (# (Int -> Int) | (Int -> Int) #) + +{-# NOINLINE apply #-} +apply :: Ty -> Int +apply (# f | #) = f 0 +apply (# | f #) = f 1 + +main :: IO () +main = do + print (apply (# (\x -> x * 2) | #)) + print (apply (# | (\x -> x * 3) #)) diff --git a/testsuite/tests/unboxedsums/unboxedsums10.stdout b/testsuite/tests/unboxedsums/unboxedsums10.stdout new file mode 100644 index 0000000000..12decc137a --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums10.stdout @@ -0,0 +1,2 @@ +0 +3 diff --git a/testsuite/tests/unboxedsums/unboxedsums11.hs b/testsuite/tests/unboxedsums/unboxedsums11.hs new file mode 100644 index 0000000000..2cac84767e --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums11.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE UnboxedSums, MagicHash #-} + +module Main where + +type Ty = (# () | () #) + +{-# NOINLINE showTy #-} +showTy :: Ty -> String +showTy (# _ | #) = "(# _ | #)" +showTy (# | () #) = "(# | () #)" + +main :: IO () +main = do + print (showTy (# undefined | #)) + print (showTy (# | () #)) diff --git a/testsuite/tests/unboxedsums/unboxedsums11.stdout b/testsuite/tests/unboxedsums/unboxedsums11.stdout new file mode 100644 index 0000000000..b32d36a531 --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums11.stdout @@ -0,0 +1,2 @@ +"(# _ | #)" +"(# | () #)" diff --git a/testsuite/tests/unboxedsums/unboxedsums2.hs b/testsuite/tests/unboxedsums/unboxedsums2.hs new file mode 100644 index 0000000000..115415f7c6 --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums2.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE UnboxedSums, MagicHash, BangPatterns #-} + +module Main where + +import GHC.Prim +import GHC.Types + +-- Code generator used to fail with illegal instruction errors when Float# is +-- involved. + +toInt :: (# Int# | Float# #) -> Int# +toInt (# i | #) = i +toInt (# | f #) = let !(I# i) = ceiling (F# f) in i + +toFloat :: (# Int# | Float# #) -> Float# +toFloat (# i | #) = let !(F# f) = fromIntegral (I# i) in f +toFloat (# | f #) = f + +data D = D { f1 :: (# Int# | Float# #) } + +instance Show D where + show (D (# i | #)) = "D " ++ show (I# i) + show (D (# | f #)) = "D " ++ show (F# f) + +main :: IO () +main = do + !(F# f) <- readLn + print (I# (toInt (# | f #))) + + !(I# i) <- readLn + print (F# (toFloat (# i | #))) + + print (D (# | f #)) + print (D (# i | #)) diff --git a/testsuite/tests/unboxedsums/unboxedsums2.stdin b/testsuite/tests/unboxedsums/unboxedsums2.stdin new file mode 100644 index 0000000000..82ef7c5f14 --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums2.stdin @@ -0,0 +1,2 @@ +20.123 +10 diff --git a/testsuite/tests/unboxedsums/unboxedsums2.stdout b/testsuite/tests/unboxedsums/unboxedsums2.stdout new file mode 100644 index 0000000000..5d7d3ffb7f --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums2.stdout @@ -0,0 +1,4 @@ +21 +10.0 +D 20.123 +D 10 diff --git a/testsuite/tests/unboxedsums/unboxedsums3.hs b/testsuite/tests/unboxedsums/unboxedsums3.hs new file mode 100644 index 0000000000..add8aa73df --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums3.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE UnboxedSums, MagicHash, BangPatterns, UnboxedTuples #-} + +module Main where + +import GHC.Prim +import GHC.Types + +import Data.Void (Void) +import System.Mem (performMajorGC) + +showAlt0 :: (# Void# | (# #) | () #) -> String +showAlt0 (# | (# #) | #) = "(# | (# #) | #)" +showAlt0 (# | | () #) = "(# | | () #)" + +showAlt1 :: (# Void | Float# #) -> String +showAlt1 (# _ | #) = "(# Void | #)" +showAlt1 (# | f #) = "(# | " ++ show (F# f) ++ "# #)" + +data D = D { f1 :: (# Void# | (# #) | () #) + , f2 :: (# Void | Float# #) + } + +showD :: D -> String +showD (D f1 f2) = showAlt0 f1 ++ "\n" ++ showAlt1 f2 + +main :: IO () +main = do + putStrLn (showAlt0 (# | (# #) | #)) + putStrLn (showAlt0 (# | | () #)) + putStrLn (showAlt1 (# undefined | #)) + putStrLn (showAlt1 (# | 8.1# #)) + putStrLn (showD (D (# | (# #) | #) (# | 1.2# #))) + performMajorGC diff --git a/testsuite/tests/unboxedsums/unboxedsums3.stdout b/testsuite/tests/unboxedsums/unboxedsums3.stdout new file mode 100644 index 0000000000..b37cc04c30 --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums3.stdout @@ -0,0 +1,6 @@ +(# | (# #) | #) +(# | | () #) +(# Void | #) +(# | 8.1# #) +(# | (# #) | #) +(# | 1.2# #) diff --git a/testsuite/tests/unboxedsums/unboxedsums4.hs b/testsuite/tests/unboxedsums/unboxedsums4.hs new file mode 100644 index 0000000000..3257a7043e --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums4.hs @@ -0,0 +1,3 @@ +module Lib where + +sum = (10 |) diff --git a/testsuite/tests/unboxedsums/unboxedsums4.stderr b/testsuite/tests/unboxedsums/unboxedsums4.stderr new file mode 100644 index 0000000000..2cd4be6c9a --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums4.stderr @@ -0,0 +1,2 @@ + +unboxedsums4.hs:3:7: error: Boxed sums not supported: ( 10 | ) diff --git a/testsuite/tests/unboxedsums/unboxedsums5.hs b/testsuite/tests/unboxedsums/unboxedsums5.hs new file mode 100644 index 0000000000..0bb8c67c7e --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums5.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE UnboxedSums #-} + +module Lib where + +-- No spaces needed in the type syntax +type T = (#Int|Bool|String#) + +-- Term syntax needs spaces, otherwise we parser bars as sections +-- for ||, ||| etc. +-- +-- t1 :: T +-- t1 = (# 10 | | #) diff --git a/testsuite/tests/unboxedsums/unboxedsums6.hs b/testsuite/tests/unboxedsums/unboxedsums6.hs new file mode 100644 index 0000000000..767366d4d5 --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums6.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE UnboxedSums, MagicHash, UnboxedTuples #-} + +-- Nesting sums and tuples is OK + +module Main where + +import GHC.Prim +import GHC.Types + +import System.Mem (performMajorGC) + +type S_T_T a b c d = (# (# a , b #) | (# c , d #) #) +type S_S_S a b c d = (# (# a | b #) | (# c | d #) #) + +show_stt :: (Show a, Show b, Show c, Show d) => S_T_T a b c d -> String +show_stt (# (# a, b #) | #) = show a ++ show b +show_stt (# | (# c, d #) #) = show c ++ show d + +show_sss :: (Show a, Show b, Show c, Show d) => S_S_S a b c d -> String +show_sss (# (# a | #) | #) = show a +show_sss (# (# | b #) | #) = show b +show_sss (# | (# c | #) #) = show c +show_sss (# | (# | d #) #) = show d + +main :: IO () +main = do + putStrLn (show_stt stt) + putStrLn (show_sss sss) + performMajorGC + where + stt :: S_T_T Int Bool Float String + stt = (# (# 123, True #) | #) + + sss :: S_S_S Int Bool Float String + sss = (# | (# 1.2 | #) #) diff --git a/testsuite/tests/unboxedsums/unboxedsums6.stdout b/testsuite/tests/unboxedsums/unboxedsums6.stdout new file mode 100644 index 0000000000..f2448cc95f --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums6.stdout @@ -0,0 +1,2 @@ +123True +1.2 diff --git a/testsuite/tests/unboxedsums/unboxedsums7.hs b/testsuite/tests/unboxedsums/unboxedsums7.hs new file mode 100644 index 0000000000..d64dabb13a --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums7.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-} + +module Main where + +import GHC.Prim +import GHC.Types + +type Either1 a b c = (# a | (# b, c #) #) + +-- The bug disappears when this is inlined +{-# NOINLINE showEither1 #-} + +showEither1 :: Either1 String Int Bool -> String +showEither1 (# left | #) = "Left " ++ show left +showEither1 (# | (# right1, right2 #) #) = "Right " ++ show right1 ++ " " ++ show right2 + +main :: IO () +main = do + -- This line used to print "Right -4611686018427359531 False" + putStrLn (showEither1 e1_2) + where + -- boxed types only + e1_2 :: Either1 String Int Bool + e1_2 = (# | (# 10, True #) #) diff --git a/testsuite/tests/unboxedsums/unboxedsums7.stdout b/testsuite/tests/unboxedsums/unboxedsums7.stdout new file mode 100644 index 0000000000..7c5942246e --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums7.stdout @@ -0,0 +1 @@ +Right 10 True diff --git a/testsuite/tests/unboxedsums/unboxedsums8.hs b/testsuite/tests/unboxedsums/unboxedsums8.hs new file mode 100644 index 0000000000..07ef122b69 --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums8.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-} + +module Main where + +import GHC.Prim +import GHC.Types + +type Sum1 = (# (# Int#, Int #) | (# Int#, Int# #) | (# Int, Int# #) #) + +{-# NOINLINE showSum1 #-} +showSum1 :: Sum1 -> String +showSum1 (# p1 | | #) = showP1 p1 +showSum1 (# | p2 | #) = showP2 p2 +showSum1 (# | | p3 #) = showP3 p3 + +{-# NOINLINE showP1 #-} +showP1 :: (# Int#, Int #) -> String +showP1 (# i1, i2 #) = show (I# i1) ++ show i2 + +{-# NOINLINE showP2 #-} +showP2 :: (# Int#, Int# #) -> String +showP2 (# i1, i2 #) = show (I# i1) ++ show (I# i2) + +{-# NOINLINE showP3 #-} +showP3 :: (# Int, Int# #) -> String +showP3 (# i1, i2 #) = show i1 ++ show (I# i2) + +main :: IO () +main = do + putStrLn (showSum1 s1) + putStrLn (showSum1 s2) + putStrLn (showSum1 s3) + where + s1, s2, s3 :: Sum1 + s1 = (# (# 123#, 456 #) | | #) + s2 = (# | (# 876#, 543# #) | #) + s3 = (# | | (# 123, 456# #) #) diff --git a/testsuite/tests/unboxedsums/unboxedsums8.stdout b/testsuite/tests/unboxedsums/unboxedsums8.stdout new file mode 100644 index 0000000000..35242be50a --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums8.stdout @@ -0,0 +1,3 @@ +123456 +876543 +123456 diff --git a/testsuite/tests/unboxedsums/unboxedsums9.hs b/testsuite/tests/unboxedsums/unboxedsums9.hs new file mode 100644 index 0000000000..79927fc58b --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums9.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-} + +module Main where + +type UbxBool = (# (# #) | (# #) #) + +{-# NOINLINE packBool #-} +packBool :: UbxBool -> Bool +packBool (# _ | #) = True +packBool (# | _ #) = False + +{-# NOINLINE unpackBool #-} +unpackBool :: Bool -> UbxBool +unpackBool True = (# (# #) | #) +unpackBool False = (# | (# #) #) + +{-# NOINLINE showUbxBool #-} +showUbxBool :: UbxBool -> String +showUbxBool b = show (packBool b) + +main :: IO () +main = do + putStrLn (showUbxBool (unpackBool True)) + putStrLn (showUbxBool (unpackBool False)) + putStrLn (show (packBool (# (# #) | #))) + putStrLn (show (packBool (# | (# #) #))) diff --git a/testsuite/tests/unboxedsums/unboxedsums9.stdout b/testsuite/tests/unboxedsums/unboxedsums9.stdout new file mode 100644 index 0000000000..7474532fd2 --- /dev/null +++ b/testsuite/tests/unboxedsums/unboxedsums9.stdout @@ -0,0 +1,4 @@ +True +False +True +False |