Tests for MINIMAL pragma (#7633)
authorTwan van Laarhoven <twanvl@gmail.com>
Thu, 12 Sep 2013 17:13:48 +0000 (19:13 +0200)
committerHerbert Valerio Riedel <hvr@gnu.org>
Wed, 18 Sep 2013 07:55:53 +0000 (09:55 +0200)
testsuite/tests/warnings/Makefile [new file with mode: 0644]
testsuite/tests/warnings/minimal/Makefile [new file with mode: 0644]
testsuite/tests/warnings/minimal/WarnMinimal.hs [new file with mode: 0644]
testsuite/tests/warnings/minimal/WarnMinimal.stderr [new file with mode: 0644]
testsuite/tests/warnings/minimal/WarnMinimalFail1.hs [new file with mode: 0644]
testsuite/tests/warnings/minimal/WarnMinimalFail1.stderr [new file with mode: 0644]
testsuite/tests/warnings/minimal/WarnMinimalFail2.hs [new file with mode: 0644]
testsuite/tests/warnings/minimal/WarnMinimalFail2.stderr [new file with mode: 0644]
testsuite/tests/warnings/minimal/WarnMinimalFail3.hs [new file with mode: 0644]
testsuite/tests/warnings/minimal/WarnMinimalFail3.stderr [new file with mode: 0644]
testsuite/tests/warnings/minimal/all.T [new file with mode: 0644]

diff --git a/testsuite/tests/warnings/Makefile b/testsuite/tests/warnings/Makefile
new file mode 100644 (file)
index 0000000..9a36a1c
--- /dev/null
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/warnings/minimal/Makefile b/testsuite/tests/warnings/minimal/Makefile
new file mode 100644 (file)
index 0000000..9101fbd
--- /dev/null
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/warnings/minimal/WarnMinimal.hs b/testsuite/tests/warnings/minimal/WarnMinimal.hs
new file mode 100644 (file)
index 0000000..d369065
--- /dev/null
@@ -0,0 +1,116 @@
+module WarnMinimal where
+
+class Fine a where
+instance Fine Int
+
+-------------------
+
+class Foo a where
+  foo1 :: a
+  foo2 :: a
+  foo1 = foo2
+  foo2 = foo1
+  {-# MINIMAL foo1 | foo2 #-}
+
+-- this should generate a warning
+instance Foo Int where  -- WARNING LINE
+
+-- this should generate no warning
+instance Foo Char where
+  foo1 = 'x'
+
+-- nor should this
+instance Foo Bool where
+  foo2 = True
+
+instance Foo Double where
+  foo1 = 1
+  foo2 = 2
+
+-------------------
+
+class Monad' f where
+  return' :: a -> f a
+  fmap' :: (a -> b) -> f a -> f b
+  join' :: f (f a) -> f a
+  bind' :: f a -> (a -> f b) -> f b
+  {-# MINIMAL return', (fmap',join' | bind') #-}
+  fmap' f x = bind' x (return' . f)
+  join' x = bind' x id
+  bind' x f = join' (fmap' f x)
+
+instance Monad' [] where
+  return' = return
+  fmap' = map
+  join' = concat
+  -- no warning
+
+instance Monad' Maybe where
+  return' = Just
+  bind' = (>>=)
+  -- no warning
+
+instance Monad' IO where
+  return' = return
+  bind' = (>>=)
+  fmap' = fmap
+  join' = (>>= id)
+  -- no warning
+
+instance Monad' ((->) e) where  -- WARNING LINE
+  return' = const
+  fmap' = (.)
+  -- warning!
+
+newtype Id a = Id a
+instance Monad' Id where  -- WARNING LINE
+  fmap' f (Id x) = Id (f x)
+  join' (Id x) = x
+  -- warning!
+
+newtype Id2 a = Id2 a
+instance Monad' Id2 where  -- WARNING LINE
+  fmap' f (Id2 x) = Id2 (f x)
+  join' (Id2 x) = x
+  bind' (Id2 x) f = f x
+  -- warning!
+
+newtype Id3 a = Id3 a
+instance Monad' Id3 where  -- WARNING LINE
+
+---------
+
+-- incorrect minimal spec
+class Cheater a where  -- WARNING LINE
+  cheater :: a
+  {-# MINIMAL #-} -- warning!
+
+class Cheater2 a where
+  _cheater2 :: a
+  {-# MINIMAL #-} -- no warning
+
+class Cheater3 a where  -- WARNING LINE
+  cheater3, cheater3b :: a
+  {-# MINIMAL cheater3 #-} -- warning!
+
+---------
+
+-- new style warning for classes without explicit spec
+instance Num Bool where  -- WARNING LINE
+
+class NoExplicit a where
+  needed :: a
+  _optional :: a
+
+instance NoExplicit Int where  -- WARNING LINE
+
+
+---------
+data Blarg = Blarg
+class Eq' a where
+  (===) :: a -> a -> Bool
+  (/==) :: a -> a -> Bool
+  x === y = not (x /== y)
+  x /== y = not (x === y)
+  {-# MINIMAL (===) | (/==) #-}
+instance Eq' Blarg where  -- WARNING LINE
diff --git a/testsuite/tests/warnings/minimal/WarnMinimal.stderr b/testsuite/tests/warnings/minimal/WarnMinimal.stderr
new file mode 100644 (file)
index 0000000..fee6e10
--- /dev/null
@@ -0,0 +1,52 @@
+
+WarnMinimal.hs:16:10: Warning:
+    No explicit implementation for
+      either ‛foo1’ or ‛foo2’
+    In the instance declaration for ‛Foo Int’
+
+WarnMinimal.hs:60:10: Warning:
+    No explicit implementation for
+      either ‛join'’ or ‛bind'’
+    In the instance declaration for ‛Monad' ((->) e)’
+
+WarnMinimal.hs:66:10: Warning:
+    No explicit implementation for
+      ‛return'’
+    In the instance declaration for ‛Monad' Id’
+
+WarnMinimal.hs:72:10: Warning:
+    No explicit implementation for
+      ‛return'’
+    In the instance declaration for ‛Monad' Id2’
+
+WarnMinimal.hs:79:10: Warning:
+    No explicit implementation for
+      ‛return'’ and (either (‛fmap'’ and ‛join'’) or ‛bind'’)
+    In the instance declaration for ‛Monad' Id3’
+
+WarnMinimal.hs:84:1: Warning:
+    The MINIMAL pragma does not require:
+      ‛cheater’
+    but there is no default implementation.
+    In the class declaration for ‛Cheater’
+
+WarnMinimal.hs:92:1: Warning:
+    The MINIMAL pragma does not require:
+      ‛cheater3b’
+    but there is no default implementation.
+    In the class declaration for ‛Cheater3’
+
+WarnMinimal.hs:99:10: Warning:
+    No explicit implementation for
+      ‛+’, ‛*’, ‛abs’, ‛signum’, and ‛fromInteger’
+    In the instance declaration for ‛Num Bool’
+
+WarnMinimal.hs:105:10: Warning:
+    No explicit implementation for
+      ‛needed’
+    In the instance declaration for ‛NoExplicit Int’
+
+WarnMinimal.hs:116:10: Warning:
+    No explicit implementation for
+      either ‛===’ or ‛/==’
+    In the instance declaration for ‛Eq' Blarg’
diff --git a/testsuite/tests/warnings/minimal/WarnMinimalFail1.hs b/testsuite/tests/warnings/minimal/WarnMinimalFail1.hs
new file mode 100644 (file)
index 0000000..7e0a3aa
--- /dev/null
@@ -0,0 +1,5 @@
+module WarnMinimalFail1 where
+
+global :: Int
+global = 0
+{-# MINIMAL global #-} -- invalid, should only be used inside a class declaration
diff --git a/testsuite/tests/warnings/minimal/WarnMinimalFail1.stderr b/testsuite/tests/warnings/minimal/WarnMinimalFail1.stderr
new file mode 100644 (file)
index 0000000..4314538
--- /dev/null
@@ -0,0 +1,3 @@
+
+WarnMinimalFail1.hs:5:1:
+    Misplaced MINIMAL pragma: {-# MINIMAL global #-}
diff --git a/testsuite/tests/warnings/minimal/WarnMinimalFail2.hs b/testsuite/tests/warnings/minimal/WarnMinimalFail2.hs
new file mode 100644 (file)
index 0000000..2ee3040
--- /dev/null
@@ -0,0 +1,8 @@
+module WarnMinimalFail2 where
+
+global :: Int
+global = 0
+
+class Foo a where
+  local :: a
+  {-# MINIMAL global #-}
diff --git a/testsuite/tests/warnings/minimal/WarnMinimalFail2.stderr b/testsuite/tests/warnings/minimal/WarnMinimalFail2.stderr
new file mode 100644 (file)
index 0000000..2648b47
--- /dev/null
@@ -0,0 +1,3 @@
+
+WarnMinimalFail2.hs:8:15:
+    ‛global’ is not a (visible) method of class ‛Foo’
diff --git a/testsuite/tests/warnings/minimal/WarnMinimalFail3.hs b/testsuite/tests/warnings/minimal/WarnMinimalFail3.hs
new file mode 100644 (file)
index 0000000..9dd6eb7
--- /dev/null
@@ -0,0 +1,13 @@
+{-# LANGUAGE DefaultSignatures #-}
+module WarnMinimalFail3 where
+
+class Parent a where
+  parent :: a
+  default parent :: Child a => a
+  parent = child
+
+class Parent a => Child a where
+  child :: a
+  child = parent
+  {-# MINIMAL parent | child #-}
+  -- we would like this to work, but it doesn't yet.
diff --git a/testsuite/tests/warnings/minimal/WarnMinimalFail3.stderr b/testsuite/tests/warnings/minimal/WarnMinimalFail3.stderr
new file mode 100644 (file)
index 0000000..5111175
--- /dev/null
@@ -0,0 +1,3 @@
+
+WarnMinimalFail3.hs:12:15:
+    ‛parent’ is not a (visible) method of class ‛Child’
diff --git a/testsuite/tests/warnings/minimal/all.T b/testsuite/tests/warnings/minimal/all.T
new file mode 100644 (file)
index 0000000..f169144
--- /dev/null
@@ -0,0 +1,4 @@
+test('WarnMinimal', normal, compile, [''])
+test('WarnMinimalFail1', normal, compile_fail, [''])
+test('WarnMinimalFail2', normal, compile_fail, [''])
+test('WarnMinimalFail3', normal, compile_fail, [''])