[commit: testsuite] master: Add another test for #1133 (39af698)

Ian Lynagh igloo at earth.li
Tue Jan 22 20:02:03 CET 2013


Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/39af698abb1831eb3d1ff405dd5c53bb57ad6f99

>---------------------------------------------------------------

commit 39af698abb1831eb3d1ff405dd5c53bb57ad6f99
Author: Ian Lynagh <ian at well-typed.com>
Date:   Tue Jan 22 19:02:56 2013 +0000

    Add another test for #1133

>---------------------------------------------------------------

 tests/deriving/should_fail/Makefile                |    5 +++++
 tests/deriving/should_fail/T1133A.hs               |    6 ++++++
 .../T1133.hs-boot => should_fail/T1133A.hs-boot}   |    2 +-
 tests/deriving/should_fail/T1133A.stderr           |    7 +++++++
 tests/deriving/should_fail/all.T                   |    5 ++++-
 5 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/tests/deriving/should_fail/Makefile b/tests/deriving/should_fail/Makefile
index 0f0995d..f9f554d 100644
--- a/tests/deriving/should_fail/Makefile
+++ b/tests/deriving/should_fail/Makefile
@@ -6,3 +6,8 @@ drvfail016:
 	$(RM) -f drvfail016.hi-boot drvfail016.o-boot
 	'$(TEST_HC)' $(TEST_HC_OPTS) -XGeneralizedNewtypeDeriving -c drvfail016.hs-boot; echo $$?
 
+.PHONY: T1133A
+T1133A:
+	$(TEST_HC) $(TEST_HC_OPTS) -c T1133A.hs-boot
+	-$(TEST_HC) $(TEST_HC_OPTS) -c T1133A.hs
+
diff --git a/tests/deriving/should_fail/T1133A.hs b/tests/deriving/should_fail/T1133A.hs
new file mode 100644
index 0000000..b5950ea
--- /dev/null
+++ b/tests/deriving/should_fail/T1133A.hs
@@ -0,0 +1,6 @@
+
+module T1133A where
+
+import {-# SOURCE #-} T1133A
+
+newtype X = X Int deriving Enum
diff --git a/tests/deriving/should_compile/T1133.hs-boot b/tests/deriving/should_fail/T1133A.hs-boot
similarity index 50%
copy from tests/deriving/should_compile/T1133.hs-boot
copy to tests/deriving/should_fail/T1133A.hs-boot
index 520a2c0..da89ec0 100644
--- a/tests/deriving/should_compile/T1133.hs-boot
+++ b/tests/deriving/should_fail/T1133A.hs-boot
@@ -1,4 +1,4 @@
 
-module T1133 where
+module T1133A where
 
 newtype X = X Int
diff --git a/tests/deriving/should_fail/T1133A.stderr b/tests/deriving/should_fail/T1133A.stderr
new file mode 100644
index 0000000..734081e
--- /dev/null
+++ b/tests/deriving/should_fail/T1133A.stderr
@@ -0,0 +1,7 @@
+
+T1133A.hs:6:28:
+    Can't make a derived instance of `Enum X':
+      `X' must be an enumeration type
+      (an enumeration consists of one or more nullary, non-GADT constructors)
+      Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension
+    In the newtype declaration for `X'
diff --git a/tests/deriving/should_fail/all.T b/tests/deriving/should_fail/all.T
index 5ddb2bd..5fface8 100644
--- a/tests/deriving/should_fail/all.T
+++ b/tests/deriving/should_fail/all.T
@@ -36,4 +36,7 @@ test('T5287', normal, compile_fail, [''])
 test('T5478', normal, compile_fail, [''])
 test('T5686', normal, compile_fail, [''])
 test('T5922', normal, compile_fail, [''])
-
+test('T1133A',
+     extra_clean(['T1133A.o-boot', 'T1133A.hi-boot']),
+     run_command,
+     ['$MAKE --no-print-directory -s T1133A'])





More information about the ghc-commits mailing list