Skip to content

GitLab

GHC
GHC
Commit ada75a84 authored by batterseapower's avatar batterseapower
Browse files
Options

Testsuite update for unboxed tuples in arguments 

We are careful to test slow calls and RtClosureInspect, as well as standard fast calls
parent 24d70dae
Hide whitespace changes
Inline Side-by-side
Showing with 226 additions and 160 deletions
testsuite/.gitignore
View file @ ada75a84
......@@ -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,11 @@ 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/tcrun051
tests/typecheck/should_run/testeq2
tests/typecheck/testeq1/typecheck.testeq1
......
testsuite/tests/ghci.debugger/Unboxed.hs 0 → 100644
View file @ ada75a84
data Unboxed1 = Unboxed1 (# Int, Bool #)
data Unboxed2 = Unboxed2 (# Int, (# Int, Bool #) #)
o1 = Unboxed1 (# 5, True #)
o2 = Unboxed2 (# 6, (# 7, False #) #)
force_them :: Int
force_them = x + (if b then 1 else 2) + y + z + (if c then 3 else 4)
where
Unboxed1 (# x, b #) = o1
Unboxed2 (# y, (# z, c #) #) = o2
\ No newline at end of file
testsuite/tests/ghci.debugger/scripts/all.T
View file @ ada75a84
......@@ -35,6 +35,7 @@ test('print031', normal, ghci_script, ['print031.script'])
test('print032', normal, ghci_script, ['print032.script'])
test('print033', normal, ghci_script, ['print033.script'])
test('print034', normal, ghci_script, ['print034.script'])
test('print035', normal, ghci_script, ['print035.script'])
test('break001', normal, ghci_script, ['break001.script'])
test('break002', normal, ghci_script, ['break002.script'])
......
testsuite/tests/ghci.debugger/scripts/break026.stdout
View file @ ada75a84
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 = _
xs :: [t] = _
go :: Integer -> [t1] -> Integer = _
xs :: [t1] = _
Stopped at break026.hs:(6,9)-(7,35)
_result :: t1 = _
f :: t1 -> t -> t1 = _
_result :: t = _
f :: t -> t1 -> t = _
Stopped at break026.hs:7:23-35
_result :: Integer = _
c :: Integer = 0
......@@ -15,25 +15,25 @@ f :: Integer -> Integer -> Integer = _
x :: Integer = 1
xs :: [Integer] = _
Stopped at break026.hs:(6,9)-(7,35)
_result :: t1 = _
f :: t1 -> t -> t1 = _
_result :: t = _
f :: t -> t1 -> t = _
Stopped at break026.hs:7:23-35
_result :: t1 = _
c :: t1 = _
f :: t1 -> Integer -> t1 = _
_result :: t = _
c :: t = _
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 = _
xs :: [t] = _
go :: Integer -> [t1] -> Integer = _
xs :: [t1] = _
Stopped at break026.hs:(6,9)-(7,35)
_result :: t1 = _
f :: t1 -> t -> t1 = _
_result :: t = _
f :: t -> t1 -> t = _
Stopped at break026.hs:7:23-35
_result :: Integer = _
c :: Integer = 0
......@@ -41,12 +41,12 @@ f :: Integer -> Integer -> Integer = _
x :: Integer = 1
xs :: [Integer] = _
Stopped at break026.hs:(6,9)-(7,35)
_result :: t1 = _
f :: t1 -> t -> t1 = _
_result :: t = _
f :: t -> t1 -> t = _
Stopped at break026.hs:7:23-35
_result :: t1 = _
c :: t1 = _
f :: t1 -> Integer -> t1 = _
_result :: t = _
c :: t = _
f :: t -> Integer -> t = _
x :: Integer = 2
xs :: [Integer] = _
Stopped at break026.hs:7:27-31
......
testsuite/tests/ghci.debugger/scripts/print035.script 0 → 100644
View file @ ada75a84
-- Unboxed tuples in data constructor arguments need to be
-- handled correctly by RtClosureInspect
:set -XUnboxedTuples -fobject-code
:l ../Unboxed
:p o1
:p o2
force_them
:p o1
:p o2
\ No newline at end of file
testsuite/tests/ghci.debugger/scripts/print035.stdout 0 → 100644
View file @ ada75a84
o1 = (_t1::Unboxed1)
o2 = (_t2::Unboxed2)
23
o1 = Unboxed1 ((#,#) 5 True)
o2 = Unboxed2 ((#,#) 6 ((#,#) 7 False))
testsuite/tests/typecheck/should_compile/tc141.stderr
View file @ ada75a84
tc141.hs:11:12:
You cannot bind scoped type variable `a'
in a pattern binding signature
In the pattern: p :: a
In the pattern: (p :: a, q :: a)
In a pattern binding: (p :: a, q :: a) = x
tc141.hs:11:31:
Couldn't match expected type `a1' with actual type `a'
`a1' is a rigid type variable bound by
an expression type signature: a1 at tc141.hs:11:31
`a' is a rigid type variable bound by
the inferred type of f :: (a, a) -> (t, a) at tc141.hs:11:1
In the expression: q :: a
In the expression: (q :: a, p)
In the expression: let (p :: a, q :: a) = x in (q :: a, p)
tc141.hs:13:13:
You cannot bind scoped type variable `a'
in a pattern binding signature
In the pattern: y :: a
In a pattern binding: y :: a = a
In the expression:
let y :: a = a in
let
v :: a
v = b
in v
tc141.hs:15:18:
Couldn't match expected type `a2' with actual type `t'
`a2' is a rigid type variable bound by
the type signature for v :: a2 at tc141.hs:14:19
`t' is a rigid type variable bound by
the inferred type of g :: a -> t -> a1 at tc141.hs:13:1
In the expression: b
In an equation for `v': v = b
In the expression:
let
v :: a
v = b
in v
tc141.hs:11:12:
You cannot bind scoped type variable `a'
in a pattern binding signature
In the pattern: p :: a
In the pattern: (p :: a, q :: a)
In a pattern binding: (p :: a, q :: a) = x
tc141.hs:11:31:
Couldn't match expected type `a1' with actual type `a'
`a1' is a rigid type variable bound by
an expression type signature: a1 at tc141.hs:11:31
`a' is a rigid type variable bound by
the inferred type of f :: (a, a) -> (t, a) at tc141.hs:11:1
In the expression: q :: a
In the expression: (q :: a, p)
In the expression: let (p :: a, q :: a) = x in (q :: a, p)
tc141.hs:13:13:
You cannot bind scoped type variable `a'
in a pattern binding signature
In the pattern: y :: a
In a pattern binding: y :: a = a
In the expression:
let y :: a = a in
let
v :: a
v = b
in v
tc141.hs:15:18:
Couldn't match expected type `a2' with actual type `t'
`a2' is a rigid type variable bound by
the type signature for v :: a2 at tc141.hs:14:19
`t' is a rigid type variable bound by
the inferred type of g :: a -> t -> a1 at tc141.hs:13:1
In the expression: b
In an equation for `v': v = b
In the expression:
let
v :: a
v = b
in v
testsuite/tests/typecheck/should_fail/T5573a.stderr deleted 100644 → 0
View file @ 24d70dae
T5573a.hs:11:16:
Couldn't match kind `ArgKind' against `(#)'
Kind incompatibility when matching types:
t0 :: ArgKind
(# t0, t1 #) :: (#)
In the expression: (# True, False #)
In the expression: (# x, (# True, False #) #)
T5573a.hs:14:6:
Couldn't match kind `ArgKind' against `(#)'
Kind incompatibility when matching types:
t0 :: ArgKind
(# t0, t1 #) :: (#)
In the pattern: (# x, y #)
In an equation for `foo3': foo3 (# x, y #) = x
testsuite/tests/typecheck/should_fail/T5573b.stderr deleted 100644 → 0
View file @ 24d70dae
T5573b.hs:6:22:
Kind mis-match
The first argument of an unboxed tuple should have kind `ArgKind',
but `(# Double#, Double# #)' has kind `(#)'
In the type signature for `foo':
foo :: Double# -> (# (# Double#, Double# #), Double# #)
testsuite/tests/typecheck/should_fail/all.T
View file @ ada75a84
......@@ -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,8 +262,6 @@ 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('T5691', normal, compile_fail, [''])
test('T5689', normal, compile_fail, [''])
test('T5684', normal, compile_fail, [''])
......
testsuite/tests/typecheck/should_fail/tcfail087.stderr deleted 100644 → 0
View file @ 24d70dae
tcfail087.hs:6:14:
Kind mis-match
Expected kind `ArgKind', but `(# Int, Int #)' has kind `(#)'
In the type `(# Int, Int #)'
In the definition of data constructor `Ex'
In the data declaration for `Ex'
testsuite/tests/typecheck/should_fail/tcfail115.stderr deleted 100644 → 0
View file @ 24d70dae
tcfail115.hs:9:24:
Couldn't match kind `ArgKind' against `(#)'
Kind incompatibility when matching types:
t0 :: ArgKind
(# Int, Int #) :: (#)
In the expression: (r :: (# Int, Int #))
In a case alternative: r -> (r :: (# Int, Int #))
tcfail115.hs:12:25:
The variable `r' cannot have an unboxed tuple type: (# Int, Int #)
In a case alternative: r -> r
In the expression: case t x of { r -> r }
In the expression: \ x -> case t x of { r -> r }
testsuite/tests/typecheck/should_fail/tcfail120.hs deleted 100644 → 0
View file @ 24d70dae
{-# LANGUAGE UnboxedTuples #-}
-- Could be ok, because nothing is bound to the unboxed tuple
-- but actually rejected, because a wild card is rather like
-- an unused variable. Could fix this, but it's really a corner case
module ShouldFail where
type T a = Int -> (# Int, Int #)
f2 :: T a -> T a
f2 t = \x -> case t x of _ -> (# 3,4 #)
testsuite/tests/typecheck/should_fail/tcfail120.stderr deleted 100644 → 0
View file @ 24d70dae
tcfail120.hs:13:26:
A wild-card pattern cannot have an unboxed tuple type:
(# Int, Int #)
In the pattern: _
In a case alternative: _ -> (# 3, 4 #)
In the expression: case t x of { _ -> (# 3, 4 #) }
testsuite/tests/typecheck/should_fail/tcfail141.hs deleted 100644 → 0
View file @ 24d70dae
{-# LANGUAGE MagicHash, UnboxedTuples #-}
-- Should fail, because f :: (# Int#, ByteArray# #)
module ShouldFail where
import GHC.Prim (Int#, ByteArray#)
main :: IO ()
main = let f = int2Integer# 0# in putStrLn ""
int2Integer# :: Int# -> (# Int#, ByteArray# #)
int2Integer# = undefined
-- This function doesn't have to work!
-- We just need it for its type.
testsuite/tests/typecheck/should_fail/tcfail141.stderr deleted 100644 → 0
View file @ 24d70dae
tcfail141.hs:10:12:
The variable `f' cannot have an unboxed tuple type:
(# Int#, ByteArray# #)
In the expression: let f = int2Integer# 0# in putStrLn ""
In an equation for `main':
main = let f = int2Integer# 0# in putStrLn ""
testsuite/tests/typecheck/should_fail/tcfail159.stderr
View file @ ada75a84
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
testsuite/tests/typecheck/should_fail/T5573a.hs → testsuite/tests/typecheck/should_run/T5573a.hs
View file @ ada75a84
{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
module T5573a where
module Main where
import GHC.Exts
-- This is ok
{-# NOINLINE foo1 #-} -- Make it harder to get right
foo1 x = (# x,x #)
bar y = let (# x, _ #) = foo1 y in x
-- Nested unboxed tuple not ok
{-# NOINLINE foo2 #-} -- Make it harder to get right
foo2 x = (# x, (# True, False #) #)
-- Unboxed tuple argument not ok
{-# 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
testsuite/tests/typecheck/should_fail/T5573b.hs → testsuite/tests/typecheck/should_run/T5573b.hs
View file @ ada75a84
{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
module T5573b where
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)
testsuite/tests/typecheck/should_run/all.T
View file @ ada75a84
......@@ -70,6 +70,11 @@ 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('tcrun051', 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 +92,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, [''])
testsuite/tests/typecheck/should_fail/tcfail087.hs → testsuite/tests/typecheck/should_run/tcrun047.hs
View file @ ada75a84
{-# LANGUAGE UnboxedTuples #-}
-- !!! Check that unboxed tuples can't be function arguments
module ShouldFail where
-- !!! 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"
g (# x,y #) = x
{-# NOINLINE g #-} -- Make it harder to get right
g (Ex (# x,y #)) = x
main = print $ g (Ex (# 10, f (# 20, 30 #) #))
\ No newline at end of file
testsuite/tests/typecheck/should_run/tcrun048.hs 0 → 100644
View file @ ada75a84
{-# 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## #)
testsuite/tests/typecheck/should_run/tcrun049.hs 0 → 100644
View file @ ada75a84
{-# LANGUAGE UnboxedTuples #-}
module Main where
type T a = Int -> (# Int, Int #)
{-# NOINLINE f2 #-}
f2 :: T a -> T a
f2 t = \x -> case t x of _ -> (# 3,4 #) -- NB: wildcard has unboxed tuple type
main = print $ case f2 (\x -> (# x, x + 1 #)) 10 of (# y, z #) -> y + z
\ No newline at end of file
testsuite/tests/typecheck/should_fail/tcfail115.hs → testsuite/tests/typecheck/should_run/tcrun050.hs
View file @ ada75a84
{-# LANGUAGE UnboxedTuples #-}
-- Unboxed tuples; c.f. tcfail120, tc209
module ShouldFail where
module Main where
type T a = Int -> (# Int, Int #)
{-# NOINLINE g #-}
--g :: (# Int, Int #) -> (# Int, Int #)
g t = case t of r -> (r :: (# Int, Int #))
{-# NOINLINE f #-}
f :: T a -> T a
f t = \x -> case t x of r -> r
main = print $ case f (\x -> g (# x, x + 1 #)) 10 of (# y, z #) -> y + z
\ No newline at end of file
testsuite/tests/typecheck/should_run/tcrun051.hs 0 → 100644
View file @ ada75a84
{-# LANGUAGE UnboxedTuples #-}
module Main where
-- Tests unboxed tuple slow calls
{-# NOINLINE g #-}
g :: Int -> (# Int, Int #) -> Int -> (# Int, (# Int #) #) -> (# #) -> Int
g a (# b, c #) d (# e, (# f #) #) (# #) = a + b + c + d + e + f
{-# NOINLINE h #-}
h :: (Int -> (# Int, Int #) -> Int -> (# Int, (# Int #) #) -> (# #) -> Int) -> (Int, Int)
h g = (g5, g5')
where
-- Apply all the arguments at once
g5' = g 1 (# 2, 3 #) 4 (# 5, (# 6 #) #) (# #)
-- Try to force argument-at-a-time application as a stress-test
g1 = g 1
g2 = g1 `seq` g1 (# 2, 3 #)
g3 = g2 `seq` g2 4
g4 = g3 `seq` g3 (# 5, (# 6 #) #)
g5 = g4 `seq` g4 (# #)
main = print $ h g
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment