From d7f2ab05494aac0561a19d75e6c4a9fccca24554 Mon Sep 17 00:00:00 2001 From: Richard Eisenberg Date: Sat, 19 Sep 2015 15:04:49 -0400 Subject: [PATCH] Test #10770 --- testsuite/tests/typecheck/should_compile/T10770a.hs | 8 ++++++++ testsuite/tests/typecheck/should_compile/T10770b.hs | 9 +++++++++ testsuite/tests/typecheck/should_compile/all.T | 2 ++ 3 files changed, 19 insertions(+) create mode 100644 testsuite/tests/typecheck/should_compile/T10770a.hs create mode 100644 testsuite/tests/typecheck/should_compile/T10770b.hs diff --git a/testsuite/tests/typecheck/should_compile/T10770a.hs b/testsuite/tests/typecheck/should_compile/T10770a.hs new file mode 100644 index 0000000000..611c86e35d --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10770a.hs @@ -0,0 +1,8 @@ +module T10770a where + +import Data.Typeable + +main = print $ foo $ Just () + +foo :: Typeable (t a) => t a -> String +foo x = let k = show $ typeOf x in k diff --git a/testsuite/tests/typecheck/should_compile/T10770b.hs b/testsuite/tests/typecheck/should_compile/T10770b.hs new file mode 100644 index 0000000000..62ae61cb6b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10770b.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fwarn-redundant-constraints #-} +module T10770b where + +f :: (Show a, Show (Maybe a)) => Maybe a -> String +f x = let k = show x in k + +g :: (Show a, Show (Maybe a)) => Maybe a -> String +g x = show x diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 6f34db4799..da71c1d742 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -475,3 +475,5 @@ test('T10642', normal, compile, ['']) test('T10744', normal, compile, ['']) test('update-existential', normal, compile, ['']) test('T10347', expect_broken(10347), compile, ['']) +test('T10770a', expect_broken(10770), compile, ['']) +test('T10770b', expect_broken(10770), compile, ['']) -- GitLab