diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs
index 1cb2f0c3989b64a5b935f3d1c548c0a58833ed83..66f5f1493eade80d8f46b26c6fc0943462e8e451 100644
--- a/tests/Tests/Properties.hs
+++ b/tests/Tests/Properties.hs
@@ -13,6 +13,7 @@ import Test.QuickCheck
 import Test.QuickCheck.Monadic
 import Text.Show.Functions ()
 
+import Control.Applicative ((<$>), (<*>))
 import Control.Arrow ((***), second)
 import Control.Exception (catch)
 import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
@@ -93,23 +94,55 @@ tl_utf32LE   = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
 t_utf32BE    = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
 tl_utf32BE   = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
 
--- This is a poor attempt to ensure that the error handling paths on
--- decode are exercised in some way.  Proper testing would be rather
--- more involved.
-t_utf8_err :: DecodeErr -> B.ByteString -> Property
-t_utf8_err (DE _ de) bs = monadicIO $ do
-  l <- run $ let len = T.length (E.decodeUtf8With de bs)
-             in (len `seq` return (Right len)) `catch`
-                (\(e::UnicodeException) -> return (Left e))
-  case l of
-    Left err -> assert $ length (show err) >= 0
-    Right n  -> assert $ n >= 0
+data Badness = Solo | Leading | Trailing
+             deriving (Eq, Show)
+
+instance Arbitrary Badness where
+    arbitrary = elements [Solo, Leading, Trailing]
+
+t_utf8_err :: Badness -> DecodeErr -> Property
+t_utf8_err bad de = do
+  let gen = case bad of
+        Solo     -> genInvalidUTF8
+        Leading  -> B.append <$> genInvalidUTF8 <*> genUTF8
+        Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
+      genUTF8 = E.encodeUtf8 <$> genUnicode
+  forAll gen $ \bs -> do
+    onErr <- genDecodeErr de
+    monadicIO $ do
+    l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
+               in (len `seq` return (Right len)) `catch`
+                  (\(e::UnicodeException) -> return (Left e))
+    assert $ case l of
+      Left err -> length (show err) >= 0
+      Right _  -> de /= Strict
 
 t_utf8_err' :: B.ByteString -> Property
 t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
                                         Left err -> length (show err) >= 0
                                         Right t  -> T.length t >= 0
 
+genInvalidUTF8 :: Gen B.ByteString
+genInvalidUTF8 = B.pack <$> oneof [
+    -- invalid leading byte of a 2-byte sequence
+    (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte
+    -- invalid leading byte of a 4-byte sequence
+  , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte
+    -- continuation bytes without a start byte
+  , listOf1 contByte
+    -- short 2-byte sequence
+  , (:[]) <$> choose (0xC2, 0xDF)
+    -- short 3-byte sequence
+  , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte
+    -- short 4-byte sequence
+  , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte
+  ]
+  where
+    contByte = (0x80 +) <$> choose (0, 0x3f)
+    upTo n gen = do
+      k <- choose (0,n)
+      vectorOf k gen
+
 s_Eq s            = (s==)    `eq` ((S.streamList s==) . S.streamList)
     where _types = s :: String
 sf_Eq p s =
diff --git a/tests/Tests/QuickCheckUtils.hs b/tests/Tests/QuickCheckUtils.hs
index 00d4d3fa2d2992e4602bed95e3c35138ddf38b2a..c1fc9435ab039d061306a8cb6c4ea36ff5f00987 100644
--- a/tests/Tests/QuickCheckUtils.hs
+++ b/tests/Tests/QuickCheckUtils.hs
@@ -18,6 +18,7 @@ module Tests.QuickCheckUtils
     , integralRandomR
 
     , DecodeErr (..)
+    , genDecodeErr
 
     , Stringy (..)
     , eq
@@ -194,16 +195,17 @@ integralRandomR  (a,b) g = case randomR (fromIntegral a :: Integer,
                                          fromIntegral b :: Integer) g of
                             (x,h) -> (fromIntegral x, h)
 
-data DecodeErr = DE String T.OnDecodeError
+data DecodeErr = Lenient | Ignore | Strict | Replace
+               deriving (Show, Eq)
 
-instance Show DecodeErr where
-    show (DE d _) = "DE " ++ d
+genDecodeErr :: DecodeErr -> Gen T.OnDecodeError
+genDecodeErr Lenient = return T.lenientDecode
+genDecodeErr Ignore  = return T.ignore
+genDecodeErr Strict  = return T.strictDecode
+genDecodeErr Replace = arbitrary
 
 instance Arbitrary DecodeErr where
-    arbitrary = oneof [ return $ DE "lenient" T.lenientDecode
-                      , return $ DE "ignore" T.ignore
-                      , return $ DE "strict" T.strictDecode
-                      , DE "replace" `fmap` arbitrary ]
+    arbitrary = elements [Lenient, Ignore, Strict, Replace]
 
 class Stringy s where
     packS    :: String -> s