diff --git a/HTF.cabal b/HTF.cabal
--- a/HTF.cabal
+++ b/HTF.cabal
@@ -1,5 +1,5 @@
 Name:             HTF
-Version:          0.11.3.4
+Version:          0.11.4.0
 License:          LGPL
 License-File:     LICENSE
 Copyright:        (c) 2005-2012 Stefan Wehr
@@ -169,7 +169,8 @@
                     text >= 0.11,
                     old-time >= 1.0,
                     array,
-                    xmlgen >= 0.6
+                    xmlgen >= 0.6,
+                    base64-bytestring
   if !os(windows)
     Build-Depends:   unix >= 2.4
   Exposed-Modules:
diff --git a/Test/Framework/Colors.hs b/Test/Framework/Colors.hs
--- a/Test/Framework/Colors.hs
+++ b/Test/Framework/Colors.hs
@@ -26,12 +26,13 @@
   , emptyColorString, (+++), unlinesColorString, colorStringFind, ensureNewlineColorString
   , colorize, colorizeText, colorize', colorizeText'
   , noColor, noColorText, noColor', noColorText'
-  , renderColorString
+  , renderColorString, maxLength
 
 ) where
 
 import qualified Data.Text as T
 import Data.String
+import Data.Maybe
 import Control.Monad
 
 firstDiffColor = Color Magenta False
@@ -88,6 +89,12 @@
 
 emptyColorString :: ColorString
 emptyColorString = noColor ""
+
+maxLength :: ColorString -> Int
+maxLength (ColorString prims) =
+    let ml (PrimColorString _ t mt) =
+            max (T.length t) (fromMaybe 0 (fmap T.length mt))
+    in sum $ map ml prims
 
 unlinesColorString :: [ColorString] -> ColorString
 unlinesColorString l =
diff --git a/Test/Framework/Diff.hs b/Test/Framework/Diff.hs
--- a/Test/Framework/Diff.hs
+++ b/Test/Framework/Diff.hs
@@ -95,15 +95,9 @@
                       string)
                  emptyColorString (addPositions groups)
     where
-#if MIN_VERSION_Diff(0,2,0)
       showDiffGroup _ (D.First s) = dc_fromFirst dc s
       showDiffGroup _ (D.Second s) = dc_fromSecond dc s
       showDiffGroup pos (D.Both inBoth _) =
-#else
-      showDiffGroup _ (D.F, s) = dc_fromFirst dc s
-      showDiffGroup _ (D.S, s) = dc_fromSecond dc s
-      showDiffGroup pos (D.B, inBoth) =
-#endif
           let showStart = not $ isFirst pos
               showEnd = not $ isLast pos
               (contextStart, ignored, contextEnd) =
diff --git a/Test/Framework/HUnitWrapper.hs b/Test/Framework/HUnitWrapper.hs
--- a/Test/Framework/HUnitWrapper.hs
+++ b/Test/Framework/HUnitWrapper.hs
@@ -103,8 +103,11 @@
 
   -- * Sub assertions
   subAssert_, subAssertVerbose_,
-  gsubAssert_, gsubAssertVerbose_
+  gsubAssert_, gsubAssertVerbose_,
 
+  -- * HUnit re-exports
+  HU.HUnitFailure
+
 ) where
 
 import Control.Exception
@@ -113,6 +116,7 @@
 import Control.Monad.Trans
 import qualified Language.Haskell.Exts.Pretty as HE
 import qualified Language.Haskell.Exts.Parser as HE
+import qualified Test.HUnit.Lang as HU
 
 import Data.List ( (\\) )
 import System.IO.Unsafe (unsafePerformIO)
@@ -359,10 +363,14 @@
         na = length actual
         in case () of
             _| ne /= na ->
-                 genericAssertFailure__ loc (mkMsg name s
-                                             ("failed at " ++ showLoc loc
-                                              ++ "\n expected length: " ++ show ne
-                                              ++ "\n actual length: " ++ show na))
+                 do let x = equalityFailedMessage (show expected) (show actual)
+                    genericAssertFailure__ loc (mkColorMsg name s
+                                                (noColor
+                                                 ("failed at " ++ showLoc loc
+                                                  ++ "\n expected length: " ++ show ne
+                                                  ++ "\n actual length: " ++ show na) +++
+                                                  (if maxLength x < 5000
+                                                   then x else emptyColorString)))
              | not (unorderedEq expected actual) ->
                  do let x = equalityFailedMessage (show expected) (show actual)
                     genericAssertFailure__ loc (mkColorMsg "assertSetEqual" s
@@ -458,7 +466,7 @@
     _assertThrows_ name loc s x (\ (_e::SomeException) -> True)
 DocAssertionNoGVariant(assertThrowsSome, Fail if evaluating the expression of type @a@ does not
                        throw an exception.)
-CreateAssertionsNoGVariant(assertThrowsSome, IO a)
+CreateAssertionsNoGVariant(assertThrowsSome, a)
 
 --
 -- Assertions on Either
diff --git a/Test/Framework/QuickCheckWrapper.hs b/Test/Framework/QuickCheckWrapper.hs
--- a/Test/Framework/QuickCheckWrapper.hs
+++ b/Test/Framework/QuickCheckWrapper.hs
@@ -37,6 +37,12 @@
   -- * Pending properties
   qcPending,
 
+  -- * Auxiliary functions
+#if !MIN_VERSION_QuickCheck(2,7,0)
+  ioProperty,
+#endif
+  assertionAsProperty,
+
   -- * Internal functions
   qcAssertion
 
@@ -46,17 +52,22 @@
 import Prelude hiding ( catch )
 #endif
 import Control.Exception ( SomeException, Exception, Handler(..),
-                           throw, catch, catches, evaluate )
+                           throw, throwIO, catch, catches, evaluate )
 import Data.Typeable (Typeable)
 import Data.Char
 import qualified Data.List as List
 import System.IO.Unsafe (unsafePerformIO)
 import Data.IORef
+import qualified Data.ByteString.Char8 as BSC
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.ByteString.Base64 as Base64
 
 import Test.QuickCheck
-
+import Test.QuickCheck.Property hiding (reason)
 import Test.Framework.TestManager
 import Test.Framework.TestManagerInternal
+import Test.HUnit.Lang (HUnitFailure(..))
 
 data QCState = QCState { qc_args :: !Args }
 
@@ -123,7 +134,8 @@
                                                in take (length s - length pendingSuffix) s
                               in quickCheckTestPending pendingMsg
                          else do let replay = "Replay argument: " ++ (show (show (Just (gen, size))))
-                                 quickCheckTestFail (Just (adjustOutput msg ++ "\n" ++ replay))
+                                     out = adjustOutput msg
+                                 quickCheckTestFail (Just (out ++ "\n" ++ replay))
                   Right (GaveUp { output=msg }) ->
                       quickCheckTestFail (Just (adjustOutput msg))
                   Right (NoExpectedFailure { output=msg }) ->
@@ -172,3 +184,17 @@
 -- without removing it from the test suite and without deleting or commenting out the property code.
 qcPending :: Testable t => String -> t -> t
 qcPending msg _ = throw (QCPendingException msg)
+
+#if !MIN_VERSION_QuickCheck(2,7,0)
+ioProperty :: Testable prop => IO prop -> Property
+ioProperty = morallyDubiousIOProperty
+#endif
+
+assertionAsProperty :: IO () -> Property
+assertionAsProperty action =
+    ioProperty $ catch action transHUnitFail >> return True
+    where
+      transHUnitFail exc@(HUnitFailure msg) =
+          let exc' = "<<<HTF<<<" ++ (BSC.unpack $ Base64.encode $ T.encodeUtf8 $ T.pack msg)
+                     ++ ">>>HTF>>>"
+          in throwIO (HUnitFailure exc')
diff --git a/Test/Framework/TestManager.hs b/Test/Framework/TestManager.hs
--- a/Test/Framework/TestManager.hs
+++ b/Test/Framework/TestManager.hs
@@ -46,6 +46,7 @@
 import System.Exit (ExitCode(..), exitWith)
 import System.Environment (getArgs)
 import Control.Exception (finally)
+import Data.Maybe
 import qualified Data.List as List
 
 import System.IO
@@ -148,8 +149,14 @@
                                               | isFailure -> Fail
                                               | otherwise -> Error
                                    in (r, (utr_location utr, utr_callingLocations utr, utr_message utr, time))
-                              else let (r, s) = deserializeQuickCheckMsg msg'
-                                   in (r, (Nothing, [], noColor s, time))
+                              else let (r, mUnitTestResult, s) = deserializeQuickCheckMsg msg'
+                                       loc = join $ fmap utr_location mUnitTestResult
+                                       callers = fromMaybe [] $ fmap utr_callingLocations mUnitTestResult
+                                       msg =
+                                           case mUnitTestResult of
+                                             Just utr -> utr_message utr +++ noColor "\n" +++ noColor s
+                                             Nothing -> noColor s
+                                   in (r, (loc, callers, msg, time))
               rr = FlatTest
                      { ft_sort = ft_sort ft
                      , ft_path = ft_path ft
diff --git a/Test/Framework/TestManagerInternal.hs b/Test/Framework/TestManagerInternal.hs
--- a/Test/Framework/TestManagerInternal.hs
+++ b/Test/Framework/TestManagerInternal.hs
@@ -36,6 +36,10 @@
 import qualified Test.HUnit.Lang as HU
 import Control.Monad.Trans.Control
 import qualified Control.Exception.Lifted as Exc
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.ByteString.Char8 as BSC
 
 assertFailureHTF :: String -> Assertion
 -- Important: force the string argument, otherwise an error embedded
@@ -56,15 +60,42 @@
 quickCheckTestPass :: String -> Assertion
 quickCheckTestPass m = assertFailureHTF (show (Pass, Just m))
 
-deserializeQuickCheckMsg :: String -> (TestResult, String)
+deserializeQuickCheckMsg :: String -> (TestResult, Maybe UnitTestResult, String)
 deserializeQuickCheckMsg msg =
     case readM msg of
       Nothing ->
-          (Error, msg)
+          (Error, Nothing, msg)
       Just (r, ms) ->
           case ms of
-            Nothing -> (r, "")
-            Just s -> (r, s)
+            Nothing -> (r, Nothing, "")
+            Just s ->
+                let (utr, msg) = extractUnitTestResult (T.pack s)
+                in (r, utr, T.unpack msg)
+    where
+      extractUnitTestResult t =
+          case breakOn (T.pack "<<<HTF<<<") t of
+            Nothing -> (Nothing, t)
+            Just (pref, rest) ->
+                case breakOn (T.pack ">>>HTF>>>") rest of
+                  Nothing -> (Nothing, t)
+                  Just (serUtr, suf) ->
+                      case Base64.decode (BSC.pack (T.unpack serUtr)) of
+                        Left _ -> (Nothing, t)
+                        Right bs ->
+                            case T.decodeUtf8' bs of
+                              Left _ -> (Nothing, t)
+                              Right x ->
+                                  case readM (T.unpack x) of
+                                    Nothing -> (Nothing, t)
+                                    Just utr ->
+                                        (Just utr,
+                                         pref `T.append` suf)
+      breakOn x t =
+          case T.breakOn x t of
+            (pref, suf) ->
+                if T.null suf
+                then Nothing
+                else Just (pref, T.drop (T.length x) suf)
 
 -- This is a HACK: we encode location and pending information as a datatype
 -- that we show and parse later using read.
diff --git a/tests/test-HTF.cabal b/tests/test-HTF.cabal
--- a/tests/test-HTF.cabal
+++ b/tests/test-HTF.cabal
@@ -28,7 +28,8 @@
                      HUnit,
                      QuickCheck,
                      Diff,
-                     haskell-src-exts
+                     haskell-src-exts,
+                     base64-bytestring
   Default-language:  Haskell2010
   Ghc-options: -threaded
   Hs-source-dirs: ., ..