Testsuite update for unboxed tuples in arguments

ghc · Mar 7, 2012 · 5b5c144 · 5b5c144
1 parent b757825
commit 5b5c144
Show file tree

Hide file tree

Showing 30 changed files with 129 additions and 170 deletions.
diff --git a/.gitignore b/.gitignore
@@ -1056,6 +1056,8 @@ tests/typecheck/should_run/T3731
 tests/typecheck/should_run/T3731-short
 tests/typecheck/should_run/T4809
 tests/typecheck/should_run/T5759
+tests/typecheck/should_run/T5573a
+tests/typecheck/should_run/T5573b
 tests/typecheck/should_run/church
 tests/typecheck/should_run/mc17
 tests/typecheck/should_run/tcrun001
@@ -1102,6 +1104,10 @@ tests/typecheck/should_run/tcrun043
 tests/typecheck/should_run/tcrun044
 tests/typecheck/should_run/tcrun045
 tests/typecheck/should_run/tcrun046
+tests/typecheck/should_run/tcrun047
+tests/typecheck/should_run/tcrun048
+tests/typecheck/should_run/tcrun049
+tests/typecheck/should_run/tcrun050
 tests/typecheck/should_run/testeq2
 tests/typecheck/testeq1/typecheck.testeq1
 

diff --git a/tests/ghci.debugger/scripts/break026.stdout b/tests/ghci.debugger/scripts/break026.stdout
@@ -1,52 +1,52 @@
 Stopped at break026.hs:(5,1)-(7,35)
-_result :: t1 = _
+_result :: t = _
 Stopped at break026.hs:5:16-22
 _result :: Integer = _
 c :: Integer = 0
-go :: Integer -> [t] -> Integer = _
+go :: Integer -> [t1] -> Integer = _
-xs :: [t] = _
+xs :: [t1] = _
 Stopped at break026.hs:(6,9)-(7,35)
-_result :: t1 = _
+_result :: t = _
-f :: t1 -> t -> t1 = _
+f :: t -> t1 -> t = _
 Stopped at break026.hs:7:23-35
 _result :: Integer = _
 c :: Integer = 0
 f :: Integer -> Integer -> Integer = _
 x :: Integer = 1
 xs :: [Integer] = _
 Stopped at break026.hs:(6,9)-(7,35)
-_result :: t1 = _
+_result :: t = _
-f :: t1 -> t -> t1 = _
+f :: t -> t1 -> t = _
 Stopped at break026.hs:7:23-35
-_result :: t1 = _
+_result :: t = _
-c :: t1 = _
+c :: t = _
-f :: t1 -> Integer -> t1 = _
+f :: t -> Integer -> t = _
 x :: Integer = 2
 xs :: [Integer] = _
 c = 1
 Stopped at break026.hs:(5,1)-(7,35)
-_result :: t1 = _
+_result :: t = _
 Stopped at break026.hs:5:16-22
 _result :: Integer = _
 c :: Integer = 0
-go :: Integer -> [t] -> Integer = _
+go :: Integer -> [t1] -> Integer = _
-xs :: [t] = _
+xs :: [t1] = _
 Stopped at break026.hs:(6,9)-(7,35)
-_result :: t1 = _
+_result :: t = _
-f :: t1 -> t -> t1 = _
+f :: t -> t1 -> t = _
 Stopped at break026.hs:7:23-35
 _result :: Integer = _
 c :: Integer = 0
 f :: Integer -> Integer -> Integer = _
 x :: Integer = 1
 xs :: [Integer] = _
 Stopped at break026.hs:(6,9)-(7,35)
-_result :: t1 = _
+_result :: t = _
-f :: t1 -> t -> t1 = _
+f :: t -> t1 -> t = _
 Stopped at break026.hs:7:23-35
-_result :: t1 = _
+_result :: t = _
-c :: t1 = _
+c :: t = _
-f :: t1 -> Integer -> t1 = _
+f :: t -> Integer -> t = _
 x :: Integer = 2
 xs :: [Integer] = _
 Stopped at break026.hs:7:27-31

diff --git a/tests/typecheck/should_compile/tc141.stderr b/tests/typecheck/should_compile/tc141.stderr
@@ -29,11 +29,11 @@ tc141.hs:13:13:
       in v
 
 tc141.hs:15:18:
-    Couldn't match expected type `a1' with actual type `t1'
+    Couldn't match expected type `a1' with actual type `t'
       `a1' is a rigid type variable bound by
            the type signature for v :: a1 at tc141.hs:14:19
-      `t1' is a rigid type variable bound by
+      `t' is a rigid type variable bound by
-           the inferred type of g :: t -> t1 -> a at tc141.hs:13:1
+          the inferred type of g :: t1 -> t -> a at tc141.hs:13:1
     In the expression: b
     In an equation for `v': v = b
     In the expression:

diff --git a/tests/typecheck/should_fail/T5573a.hs b/tests/typecheck/should_fail/T5573a.hs
diff --git a/tests/typecheck/should_fail/T5573a.stderr b/tests/typecheck/should_fail/T5573a.stderr
diff --git a/tests/typecheck/should_fail/T5573b.hs b/tests/typecheck/should_fail/T5573b.hs
diff --git a/tests/typecheck/should_fail/T5573b.stderr b/tests/typecheck/should_fail/T5573b.stderr
diff --git a/tests/typecheck/should_fail/all.T b/tests/typecheck/should_fail/all.T
@@ -73,7 +73,6 @@ test('tcfail083', normal, compile_fail, [''])
 test('tcfail084', normal, compile_fail, [''])
 test('tcfail085', normal, compile_fail, [''])
 test('tcfail086', normal, compile_fail, [''])
-test('tcfail087', only_compiler_types(['ghc']), compile_fail, [''])
 test('tcfail088', normal, compile_fail, [''])
 test('tcfail089', normal, compile_fail, [''])
 test('tcfail090', only_compiler_types(['ghc']), compile_fail, [''])
@@ -99,12 +98,10 @@ test('tcfail110', normal, compile_fail, [''])
 test('tcfail112', normal, compile_fail, [''])
 test('tcfail113', normal, compile_fail, [''])
 test('tcfail114', normal, compile_fail, [''])
-test('tcfail115', only_compiler_types(['ghc']), compile_fail, [''])
 test('tcfail116', normal, compile_fail, [''])
 test('tcfail117', normal, compile_fail, [''])
 test('tcfail118', normal, compile_fail, [''])
 test('tcfail119', normal, compile_fail, [''])
-test('tcfail120', only_compiler_types(['ghc']), compile_fail, [''])
 test('tcfail121', normal, compile_fail, [''])
 test('tcfail122', only_compiler_types(['ghc']), compile_fail, [''])
 test('tcfail123', only_compiler_types(['ghc']), compile_fail, [''])
@@ -128,7 +125,6 @@ test('tcfail138', normal, compile, [''])
 
 test('tcfail139', normal, compile_fail, [''])
 test('tcfail140', normal, compile_fail, [''])
-test('tcfail141', only_compiler_types(['ghc']), compile_fail, [''])
 test('tcfail142', normal, compile_fail, [''])
 test('tcfail143', normal, compile_fail, [''])
 test('tcfail144', normal, compile, [''])
@@ -266,7 +262,5 @@ test('AssocTyDef08', normal, compile_fail, [''])
 test('AssocTyDef09', normal, compile_fail, [''])
 test('T3592', normal, compile_fail, [''])
 test('T5570', normal, compile_fail, [''])
-test('T5573a', normal, compile_fail, [''])
-test('T5573b', normal, compile_fail, [''])
 test('T5689', normal, compile_fail, [''])
 test('T5684', normal, compile_fail, [''])
diff --git a/tests/typecheck/should_fail/tcfail087.hs b/tests/typecheck/should_fail/tcfail087.hs
diff --git a/tests/typecheck/should_fail/tcfail087.stderr b/tests/typecheck/should_fail/tcfail087.stderr
diff --git a/tests/typecheck/should_fail/tcfail115.hs b/tests/typecheck/should_fail/tcfail115.hs
diff --git a/tests/typecheck/should_fail/tcfail115.stderr b/tests/typecheck/should_fail/tcfail115.stderr
diff --git a/tests/typecheck/should_fail/tcfail120.hs b/tests/typecheck/should_fail/tcfail120.hs
diff --git a/tests/typecheck/should_fail/tcfail120.stderr b/tests/typecheck/should_fail/tcfail120.stderr
diff --git a/tests/typecheck/should_fail/tcfail141.hs b/tests/typecheck/should_fail/tcfail141.hs
diff --git a/tests/typecheck/should_fail/tcfail141.stderr b/tests/typecheck/should_fail/tcfail141.stderr
diff --git a/tests/typecheck/should_fail/tcfail159.stderr b/tests/typecheck/should_fail/tcfail159.stderr
@@ -1,8 +1,8 @@
 
 tcfail159.hs:9:11:
-    Couldn't match kind `*' against `(#)'
+    Couldn't match kind `*' against `#'
     Kind incompatibility when matching types:
       t0 :: *
-      (# Int, Int #) :: (#)
+      (# Int, Int #) :: #
     In the pattern: ~(# p, q #)
     In a case alternative: ~(# p, q #) -> p
diff --git a/tests/typecheck/should_run/T5573a.hs b/tests/typecheck/should_run/T5573a.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
+module Main where
+
+import GHC.Exts
+
+{-# NOINLINE foo1 #-} -- Make it harder to get right
+foo1 x = (# x,x #)
+
+{-# NOINLINE foo2 #-} -- Make it harder to get right
+foo2 x = (# x, (# True, False #) #)
+
+{-# NOINLINE foo3 #-} -- Make it harder to get right
+foo3 (# x,y #) = x
+
+main = print $ foo3 (# if b then x + y else x - y, 30 #)
+  where (# x,  _ #) = foo1 10
+        (# y, (# b, _ #) #) = foo2 20
diff --git a/tests/typecheck/should_run/T5573a.stdout b/tests/typecheck/should_run/T5573a.stdout
@@ -0,0 +1 @@
+30
diff --git a/tests/typecheck/should_run/T5573b.hs b/tests/typecheck/should_run/T5573b.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
+module Main where
+
+import GHC.Exts
+
+{-# NOINLINE foo #-} -- Make it harder to get right
+foo :: Double# -> (# (# Double#, Double# #), Double# #)
+foo x = (# (# x, x #), x #)
+
+main :: IO ()
+main = case foo 1.0## of
+        (# (# x, y #), z #) -> print (D# x + D# y + D# z)
diff --git a/tests/typecheck/should_run/T5573b.stdout b/tests/typecheck/should_run/T5573b.stdout
@@ -0,0 +1 @@
+3.0
diff --git a/tests/typecheck/should_run/all.T b/tests/typecheck/should_run/all.T
@@ -70,6 +70,10 @@ test('tcrun043', normal, compile_and_run, [''])
 test('tcrun044', normal, compile_and_run, [''])
 test('tcrun045', normal, compile_and_run, [''])
 test('tcrun046', normal, compile_and_run, [''])
+test('tcrun047', compose(omit_ways(['ghci']),only_compiler_types(['ghc'])), compile_and_run, [''])
+test('tcrun048', compose(omit_ways(['ghci']),only_compiler_types(['ghc'])), compile_and_run, [''])
+test('tcrun049', compose(omit_ways(['ghci']),only_compiler_types(['ghc'])), compile_and_run, [''])
+test('tcrun050', compose(omit_ways(['ghci']),only_compiler_types(['ghc'])), compile_and_run, [''])
 
 test('church', normal, compile_and_run, [''])
 test('testeq2', normal, compile_and_run, [''])
@@ -87,3 +91,5 @@ test('T4809', reqlib('mtl'), compile_and_run, [''])
 test('T2722', normal, compile_and_run, [''])
 test('mc17', normal, compile_and_run, [''])
 test('T5759', normal, compile_and_run, [''])
+test('T5573a', compose(omit_ways(['ghci']),only_compiler_types(['ghc'])), compile_and_run, [''])
+test('T5573b', compose(omit_ways(['ghci']),only_compiler_types(['ghc'])), compile_and_run, [''])
diff --git a/tests/typecheck/should_run/tcrun047.hs b/tests/typecheck/should_run/tcrun047.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE UnboxedTuples #-}
+
+-- !!! Check that unboxed tuples can be function arguments
+module Main where
+
+data Ex = Ex (# Int,Int #)
+
+{-# NOINLINE f #-} -- Make it harder to get right
+f :: (# Int,Int #) -> Int
+f x = error "urk"
+
+{-# NOINLINE g #-} -- Make it harder to get right
+g (Ex (# x,y #)) = x
+
+
+main = print $ g (Ex (# 10, f (# 20, 30 #) #))
diff --git a/tests/typecheck/should_run/tcrun047.stdout b/tests/typecheck/should_run/tcrun047.stdout
@@ -0,0 +1 @@
+10
diff --git a/tests/typecheck/should_run/tcrun048.hs b/tests/typecheck/should_run/tcrun048.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+module Main where
+
+import GHC.Prim (Int#, Double#)
+
+main :: IO ()
+main = let f = int2Integer# 0# in putStrLn ""
+
+
+{-# NOINLINE int2Integer# #-}
+int2Integer# :: Int# -> (# Int#, Double# #)
+int2Integer# x = (# x, 1.0## #)
diff --git a/tests/typecheck/should_run/tcrun048.stdout b/tests/typecheck/should_run/tcrun048.stdout
@@ -0,0 +1 @@
+