diff --git a/testsuite/tests/ghc-regress/deriving/should_compile/all.T b/testsuite/tests/ghc-regress/deriving/should_compile/all.T
index 17a3ca01cc72277fbae3983ac66f9fe073505c69..78cc921606172e2d31b744490e4d16b8d743d8ae 100644
--- a/testsuite/tests/ghc-regress/deriving/should_compile/all.T
+++ b/testsuite/tests/ghc-regress/deriving/should_compile/all.T
@@ -14,3 +14,4 @@ test('drv013', normal, compile, [''])
 test('drv014', normal, compile, [''])
 test('drv015', normal, compile, [''])
 test('drv020', normal, compile, [''])
+test('drv021', normal, compile, [''])
diff --git a/testsuite/tests/ghc-regress/deriving/should_compile/drv021.hs b/testsuite/tests/ghc-regress/deriving/should_compile/drv021.hs
new file mode 100644
index 0000000000000000000000000000000000000000..c9800508def7061b21c6f1e7546ccffcc0171aa1
--- /dev/null
+++ b/testsuite/tests/ghc-regress/deriving/should_compile/drv021.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC  -XDeriveDataTypeable -XStandaloneDeriving #-}
+
+-- See Trac #1825
+-- Test stand-alone deriving for Typeable
+-- Horridly, one needs to define instance for Typeable1 etc
+
+module ShouldCompile where
+
+import Data.Typeable
+
+data T1 a   = T1 a
+data T2 a b = T2 a b 
+
+deriving instance Typeable1 T1
+deriving instance Typeable2 T2
+
diff --git a/testsuite/tests/ghc-regress/deriving/should_fail/all.T b/testsuite/tests/ghc-regress/deriving/should_fail/all.T
index 00cd619ca9777f40b0127660c8b6813bce52786b..fd950ceb59df0a578a552a831a4a8680ef0d6a85 100644
--- a/testsuite/tests/ghc-regress/deriving/should_fail/all.T
+++ b/testsuite/tests/ghc-regress/deriving/should_fail/all.T
@@ -12,3 +12,4 @@ test('drvfail010', normal, compile_fail, [''])
 test('drvfail011', normal, compile_fail, [''])
 test('drvfail012', normal, compile_fail, [''])
 test('drvfail013', normal, compile_fail, [''])
+test('drvfail014', normal, compile_fail, [''])
diff --git a/testsuite/tests/ghc-regress/deriving/should_fail/drvfail014.hs b/testsuite/tests/ghc-regress/deriving/should_fail/drvfail014.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9039332f292df79b819449730b181203c4a8dff8
--- /dev/null
+++ b/testsuite/tests/ghc-regress/deriving/should_fail/drvfail014.hs
@@ -0,0 +1,13 @@
+{-# OPTIONS_GHC  -XDeriveDataTypeable -XStandaloneDeriving #-}
+
+-- See Trac #1825
+
+module ShouldFail where
+import Data.Typeable
+
+data T1 a = T1 a deriving( Typeable1 )
+
+data T2 a b = T2 a b 
+
+deriving instance (Typeable a, Typeable b) => Typeable (T2 a b)
+	-- c.f. drv021.hs
diff --git a/testsuite/tests/ghc-regress/deriving/should_fail/drvfail014.stderr b/testsuite/tests/ghc-regress/deriving/should_fail/drvfail014.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..69b01a84baf0e554d7345875e4f2e86b17b43448
--- /dev/null
+++ b/testsuite/tests/ghc-regress/deriving/should_fail/drvfail014.stderr
@@ -0,0 +1,9 @@
+
+drvfail014.hs:8:0:
+    Use deriving( Typeable ) on a data type declaration
+    In the data type declaration for `T1'
+
+drvfail014.hs:12:0:
+    Derived typeable instance must be of form (Typeable2 T2)
+    In the stand-alone deriving instance for
+      `(Typeable a, Typeable b) => Typeable (T2 a b)'