Commit f17d2384 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Test Trac #3087

parent d28fa121
{-# LANGUAGE RankNTypes, DeriveDataTypeable #-}
module Main where
import Data.Generics
data MyMaybe a = MyNothing | MyJust a deriving (Data, Typeable)
test1 :: ()
test1 = undefined `ext1Q` (\ (Just _) -> ()) $ Just ()
test1' :: ()
test1' = undefined `ext1Q` (\ (MyJust _) -> ()) $ MyJust ()
newtype Q r a = Q { unQ :: a -> r }
ext2Q :: (Data d, Typeable2 t)
=> (d -> q) -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)
-> d -> q
ext2Q def ext arg =
case dataCast2 (Q ext) of
Just (Q ext') -> ext' arg
Nothing -> def arg
data MyPair a b = MyPair a b deriving (Data, Typeable)
test2 :: ()
test2 = undefined `ext2Q` (\(_,_) -> ()) $ ((),())
test2' :: ()
test2' = undefined `ext2Q` (\(MyPair _ _) -> ()) $ MyPair () ()
main = do { print test1; print test1'; print test2; print test2' }
......@@ -25,6 +25,7 @@ test('drvrun019', normal, compile_and_run, [''])
test('drvrun020', normal, compile_and_run, [''])
test('drvrun021', normal, compile_and_run, [''])
test('drvrun022', normal, compile_and_run, ['-package syb'])
test('T3087', normal, compile_and_run, ['-package syb'])
test('T2529', normal, compile_and_run, [''])
test('drvrun-functor1',
if_compiler_lt('ghc', '6.11', expect_fail),
......
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