Commit ba72db2f authored by simonpj's avatar simonpj
Browse files

Add test for bug 685

parent 0bc7a5ec
{-# OPTIONS -fglasgow-exts -O #-}
module Gadt17_help (
TernOp (..), applyTernOp
) where
data TypeWitness a where
TWInt :: TypeWitness Int
TWBool :: TypeWitness Bool
TWFloat :: TypeWitness Float
TWDouble :: TypeWitness Double
instance (Eq a) => Eq (TypeWitness a) where
(==) TWInt TWInt = True
(==) TWBool TWBool = True
(==) TWFloat TWFloat = True
(==) TWDouble TWDouble = True
(==) _ _ = False
data TernOp a b c d where
OpIf :: TypeWitness a -> TernOp Bool a a a
OpTernFunc :: TypeWitness a -> TypeWitness b -> TypeWitness c
-> TypeWitness d -> (a -> b -> c -> d) -> TernOp a b c d
instance Show (TernOp a b c d) where
show (OpIf {}) = "OpIf"
show (OpTernFunc {}) = "OpTernFunc <function>"
applyTernOp :: TernOp a b c d -> a -> b -> c -> d
applyTernOp (OpIf {}) cond x y = if (cond) then x else y
applyTernOp (OpTernFunc _ _ _ _ f) x y z = f x y z
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
# A mulit-module test that made GHC 6.4.1 crash
gadt17:
@$(RM) gadt17.hi Gadt17_help.hi
@$(RM) A$(OBJSUFFIX)
$(TEST_HC) -c Gadt17_help.hs
$(TEST_HC) -c gadt17.hs
......@@ -19,6 +19,9 @@ test('gadt14', normal, compile, [''])
test('gadt15', normal, compile, [''])
test('gadt16', normal, compile, [''])
clean(['Gadt17_help.hi', 'Gadt17_help.o'])
test('gadt17', normal, run_command_ignore_output, ['$MAKE gadt17'])
test('red-black', normal, compile, [''])
test('type-rep', skip_if_fast, compile_and_run, [''])
test('equal', normal, compile, [''])
......
{-# OPTIONS -fglasgow-exts -O #-}
-- This one showed up a bug that required type refinement in TcIface
-- See the call to coreRefineTys in TcIface
--
-- Tests for bug: http://hackage.haskell.org/trac/ghc/ticket/685
module ShouldCompile where
import Gadt17_help ( TernOp (..), applyTernOp )
liftTernOpObs :: TernOp a b c d -> a -> b -> c -> d
liftTernOpObs op x y z = applyTernOp op x y z
......@@ -44,6 +44,7 @@ test('rn045', normal, compile, [''])
test('rn046', normal, compile, ['-W'])
test('rn047', normal, compile, ['-W'])
test('rn048', normal, compile, ['-W'])
test('rn049', normal, compile, ['-W'])
test('timing001', normal, compile, [''])
test('timing002', normal, compile, [''])
......
-- GHC 6.4.1 said
-- test.hs:1:5:
-- Warning: accepting non-standard pattern guards
-- (-fglasgow-exts to suppress this message)
-- [x <- ((1 * 2) + 3) * 4, undefined]
-- Note the wrongly-parenthesised expression
module ShouldCompile where
main | x <- 1*2+3*4 = undefined
\ 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