diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml
index 75b03ac3c1ae823283f07c53f70e7a9b687367a3..5613fb37378d5a9af41d9e09e595662b4d4a0ef5 100644
--- a/.github/workflows/test.yaml
+++ b/.github/workflows/test.yaml
@@ -50,7 +50,9 @@ jobs:
         set -eux
         cabal update
         cabal build --enable-tests --enable-benchmarks
-        cabal test
+        cabal test --test-show-details=direct filepath-tests
+        cabal test --test-show-details=direct --test-options='--quickcheck-tests 50_000' filepath-equivalent-tests
+        cabal test --test-show-details=direct abstract-filepath
         cabal bench
         cabal haddock
         cabal check
diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs
index 786eb3a3a4842a1451d59193a85355de6fa92c1b..64534e8c1848a14ca3205799a66db7b3de0dc450 100644
--- a/System/FilePath/Internal.hs
+++ b/System/FilePath/Internal.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE MultiWayIf #-}
 
 -- This template expects CPP definitions for:
 --     MODULE_NAME = Posix | Windows
@@ -602,6 +603,7 @@ isDrive x = not (null x) && null (dropDrive x)
 -- > Posix:   splitFileName "/" == ("/","")
 -- > Windows: splitFileName "c:" == ("c:","")
 -- > Windows: splitFileName "\\\\?\\A:\\fred" == ("\\\\?\\A:\\","fred")
+-- > Windows: splitFileName "\\\\?\\A:" == ("\\\\?\\A:","")
 splitFileName :: FILEPATH -> (STRING, STRING)
 splitFileName x = if null path
     then (dotSlash, file)
@@ -644,20 +646,43 @@ splitFileName_ fp
   -- or UNC location "\\?\UNC\foo", where path separator is a part of the drive name.
   -- We can test this by trying dropDrive and falling back to splitDrive.
   | isWindows
-  , Just (s1, _s2, bs') <- uncons2 dirSlash
-  , isPathSeparator s1
-  -- If bs' is empty, then s2 as the last character of dirSlash must be a path separator,
-  -- so we are in the middle of shared drive.
-  -- Otherwise, since s1 is a path separator, we might be in the middle of UNC path.
-  , null bs' || maybe False isIncompleteUNC (readDriveUNC dirSlash)
-  = (fp, mempty)
+  = case uncons2 dirSlash of
+    Just (s1, s2, bs')
+      | isPathSeparator s1
+      -- If bs' is empty, then s2 as the last character of dirSlash must be a path separator,
+      -- so we are in the middle of shared drive.
+      -- Otherwise, since s1 is a path separator, we might be in the middle of UNC path.
+      , null bs' || maybe False isIncompleteUNC (readDriveUNC dirSlash)
+      -> (fp, mempty)
+      -- This handles inputs like "//?/A:" and "//?/A:foo"
+      | isPathSeparator s1
+      , isPathSeparator s2
+      , Just (s3, s4, bs'') <- uncons2 bs'
+      , s3 == _question
+      , isPathSeparator s4
+      , null bs''
+      , Just (drive, rest) <- readDriveLetter file
+      -> (dirSlash <> drive, rest)
+    _ -> (dirSlash, file)
   | otherwise
-  = (dirSlash, file)
+    = (dirSlash, file)
   where
     (dirSlash, file) = breakEnd isPathSeparator fp
-
+    dropExcessTrailingPathSeparators x
+      | hasTrailingPathSeparator x
+      , let x' = dropWhileEnd isPathSeparator x
+      , otherwise = if | null x' -> singleton (last x)
+                       | otherwise -> addTrailingPathSeparator x'
+      | otherwise = x
+
+    -- an "incomplete" UNC is one without a path (but potentially a drive)
     isIncompleteUNC (pref, suff) = null suff && not (hasPenultimateColon pref)
-    hasPenultimateColon = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc
+
+    -- e.g. @//?/a:/@ or @//?/a://@, but not @//?/a:@
+    hasPenultimateColon pref
+      | hasTrailingPathSeparator pref
+      = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropExcessTrailingPathSeparators $ pref
+      | otherwise = False
 
 -- | Set the filename.
 --
@@ -671,6 +696,7 @@ replaceFileName x y = a </> y where (a,_) = splitFileName_ x
 --
 -- > dropFileName "/directory/file.ext" == "/directory/"
 -- > dropFileName x == fst (splitFileName x)
+-- > isPrefixOf (takeDrive x) (dropFileName x)
 dropFileName :: FILEPATH -> FILEPATH
 dropFileName = fst . splitFileName
 
diff --git a/filepath.cabal b/filepath.cabal
index 7bf731717a51d0150cb2f614c6df252b0641043d..56fba52d5361d3d1dfb18f67fe18e23aa53ae54e 100644
--- a/filepath.cabal
+++ b/filepath.cabal
@@ -138,8 +138,12 @@ test-suite filepath-equivalent-tests
     , base
     , bytestring  >=0.11.3.0
     , filepath
+    , generic-random
+    , generic-deriving
     , os-string   >=2.0.1
     , QuickCheck  >=2.7      && <2.15
+    , tasty
+    , tasty-quickcheck
 
 test-suite abstract-filepath
   default-language: Haskell2010
diff --git a/tests/filepath-equivalent-tests/TestEquiv.hs b/tests/filepath-equivalent-tests/TestEquiv.hs
index 83b71c39b5585b8da75736886cdebac99ec4eac0..4405ea4042f13b2b570fb90b321da788c587f303 100644
--- a/tests/filepath-equivalent-tests/TestEquiv.hs
+++ b/tests/filepath-equivalent-tests/TestEquiv.hs
@@ -1,24 +1,200 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia, TypeOperators #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Main where
 
-import Test.QuickCheck hiding ((==>))
+import Test.Tasty
+import Test.Tasty.QuickCheck hiding ((==>))
 import TestUtil
 import Prelude as P
+import Data.Char (isAsciiLower, isAsciiUpper)
+import Data.List.NonEmpty (NonEmpty(..))
+import Generic.Random
+import Generics.Deriving.Show
+import GHC.Generics
 
 import qualified System.FilePath.Windows as W
 import qualified System.FilePath.Posix as P
 import qualified Legacy.System.FilePath.Windows as LW
 import qualified Legacy.System.FilePath.Posix as LP
-import Data.Char (isAsciiLower, isAsciiUpper)
+import qualified Data.List.NonEmpty as NE
+
+
+class AltShow a where
+  altShow :: a -> String
+
+instance {-# OVERLAPPABLE #-} Show a => AltShow a where
+  altShow = show
+
+instance {-# OVERLAPS #-} AltShow String where
+  altShow = id
+
+instance {-# OVERLAPPABLE #-} AltShow a => AltShow (Maybe a) where
+  altShow Nothing = ""
+  altShow (Just a) = altShow a
+
+
+newtype WindowsFilePaths = WindowsFilePaths { unWindowsFilePaths :: [WindowsFilePath] }
+  deriving (Show, Eq, Ord, Generic)
+
+-- filepath = namespace *"\" namespace-tail
+--          / UNC
+--          / [ disk ] *"\" relative-path
+--          / disk *"\"
+data WindowsFilePath = NS NameSpace [Separator] NSTail
+                     | UNC UNCShare
+                     | N (Maybe Char) [Separator] (Maybe RelFilePath)
+                     -- ^ This differs from the grammar, because we allow
+                     -- empty paths
+                     | PotentiallyInvalid FilePath
+                     -- ^ this branch is added purely for the tests
+  deriving (GShow, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryU `AndShrinking` WindowsFilePath)
+
+instance Show WindowsFilePath where
+  show wf = gshow wf ++ " (" ++ altShow wf ++ ")"
+
+instance AltShow WindowsFilePath where
+  altShow (NS ns seps nstail) = altShow ns ++ altShow seps ++ altShow nstail
+  altShow (UNC unc) = altShow unc
+  altShow (N mdisk seps mfrp) = maybe [] (:[]) mdisk ++ (altShow seps ++ maybe "" altShow mfrp)
+  altShow (PotentiallyInvalid fp) = fp
+
+
+-- namespace-tail     = ( disk 1*"\" relative-path ; C:foo\bar is not valid
+--                                                 ; namespaced paths are all absolute
+--                      / disk *"\"
+--                      / relative-path
+--                      )
+data NSTail = NST1 Char (NonEmpty Separator) RelFilePath
+            | NST2 Char [Separator]
+            | NST3 RelFilePath
+  deriving (GShow, Show, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryU `AndShrinking` NSTail)
+
+instance AltShow NSTail where
+  altShow (NST1 disk seps relfp) = disk:':':(altShow seps ++ altShow relfp)
+  altShow (NST2 disk seps) = disk:':':altShow seps
+  altShow (NST3 relfp) = altShow relfp
+
+
+--  UNC = "\\" 1*pchar "\" 1*pchar  [ 1*"\" [ relative-path ] ]
+data UNCShare = UNCShare Separator Separator
+                         NonEmptyString
+                         (NonEmpty Separator)
+                         NonEmptyString
+                         (Maybe (NonEmpty Separator, Maybe RelFilePath))
+  deriving (GShow, Show, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryU `AndShrinking` UNCShare)
+
+instance AltShow UNCShare where
+  altShow (UNCShare sep1 sep2 fp1 seps fp2 mrfp) = altShow sep1 ++ altShow sep2 ++ altShow fp1 ++ altShow seps ++ altShow fp2 ++ maybe "" (\(a, b) -> altShow a ++ maybe "" altShow b) mrfp
+
+newtype NonEmptyString = NonEmptyString (NonEmpty Char)
+  deriving (GShow, Show, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryU `AndShrinking` NonEmptyString)
+
+instance AltShow NonEmptyString where
+  altShow (NonEmptyString ns) = NE.toList ns
+
+
+-- | Windows API Namespaces
+--
+-- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#namespaces
+-- https://support.microsoft.com/en-us/topic/70b92942-a643-2f2d-2ac6-aad8acad49fb
+-- https://superuser.com/a/1096784/854039
+-- https://reverseengineering.stackexchange.com/a/15178
+-- https://stackoverflow.com/a/25099634
+--
+-- namespace          = file-namespace / device-namespace / nt-namespace
+-- file-namespace     = "\" "\" "?" "\"
+-- device-namespace   = "\" "\" "." "\"
+-- nt-namespace       = "\" "?" "?" "\"
+data NameSpace = FileNameSpace
+               | DeviceNameSpace
+               | NTNameSpace
+  deriving (GShow, Show, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryU `AndShrinking` NameSpace)
+
+instance AltShow NameSpace where
+  altShow FileNameSpace = "\\\\?\\"
+  altShow DeviceNameSpace = "\\\\.\\"
+  altShow NTNameSpace = "\\??\\"
+
+
+data Separator = UnixSep
+               | WindowsSep
+  deriving (GShow, Show, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryU `AndShrinking` Separator)
+
+instance AltShow Separator where
+  altShow UnixSep = "/"
+  altShow WindowsSep = "\\"
+
+instance {-# OVERLAPS #-} AltShow (NonEmpty Separator) where
+  altShow ne = mconcat $ NE.toList (altShow <$> ne)
+
+instance {-# OVERLAPS #-} AltShow [Separator] where
+  altShow [] = ""
+  altShow ne = altShow (NE.fromList ne)
+
+--  relative-path = 1*(path-name 1*"\") [ file-name ] / file-name
+data RelFilePath = Rel1 (NonEmpty (NonEmptyString, NonEmpty Separator)) (Maybe FileName)
+                 | Rel2 FileName
+  deriving (GShow, Show, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryU `AndShrinking` RelFilePath)
+
+instance AltShow RelFilePath where
+  altShow (Rel1 ns mf) = (mconcat $ NE.toList $ fmap (\(a, b) -> altShow a ++ altShow b) ns) ++ maybe "" altShow mf
+  altShow (Rel2 fn) = altShow fn
+
+--  file-name = 1*pchar [ stream ]
+data FileName = FileName NonEmptyString (Maybe DataStream)
+  deriving (GShow, Show, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryU `AndShrinking` FileName)
+
+instance AltShow FileName where
+  altShow (FileName ns ds) = altShow ns ++ altShow ds
+
+--  stream = ":" 1*schar [ ":" 1*schar ] / ":" ":" 1*schar
+data DataStream = DS1 NonEmptyString (Maybe NonEmptyString)
+                | DS2 NonEmptyString -- ::datatype
+  deriving (GShow, Show, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryU `AndShrinking` DataStream)
+
+instance AltShow DataStream where
+  altShow (DS1 ns Nothing) = ":" ++ altShow ns
+  altShow (DS1 ns (Just ns2)) = ":" ++ altShow ns ++ ":" ++ altShow ns2
+  altShow (DS2 ns) = "::" ++ altShow ns
+
+instance Arbitrary WindowsFilePaths where
+  arbitrary = scale (`mod` 20) $ genericArbitrary uniform
+
+instance Arbitrary [Separator] where
+  arbitrary = scale (`mod` 20) $ genericArbitrary uniform
+
+instance Arbitrary a => Arbitrary (NonEmpty a) where
+  arbitrary = scale (`mod` 20) $ do
+    x <- arbitrary
+    case x of
+      [] -> (NE.fromList . (:[])) <$> arbitrary
+      xs -> pure (NE.fromList xs)
 
 
 main :: IO ()
-main = runTests equivalentTests
+main = defaultMain equivalentTests
 
 
-equivalentTests :: [(String, Property)]
-equivalentTests =
+equivalentTests :: TestTree
+equivalentTests = testProperties "equivalence" $
   [
     ( "pathSeparator (windows)"
     , property $ W.pathSeparator == LW.pathSeparator
@@ -49,39 +225,41 @@ equivalentTests =
     )
     ,
     ( "splitSearchPath (windows)"
-    , property $ \p -> W.splitSearchPath p == LW.splitSearchPath p
+    , property $ \(xs :: WindowsFilePaths)
+      -> let p = (intercalate ";" (altShow <$> unWindowsFilePaths xs))
+         in W.splitSearchPath p == LW.splitSearchPath p
     )
     ,
     ( "splitExtension (windows)"
-    , property $ \p -> W.splitExtension p == LW.splitExtension p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.splitExtension p == LW.splitExtension p
     )
     ,
     ( "takeExtension (windows)"
-    , property $ \p -> W.takeExtension p == LW.takeExtension p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.takeExtension p == LW.takeExtension p
     )
     ,
     ( "replaceExtension (windows)"
-    , property $ \p s -> W.replaceExtension p s == LW.replaceExtension p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceExtension p s == LW.replaceExtension p s
     )
     ,
     ( "dropExtension (windows)"
-    , property $ \p -> W.dropExtension p == LW.dropExtension p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.dropExtension p == LW.dropExtension p
     )
     ,
     ( "addExtension (windows)"
-    , property $ \p s -> W.addExtension p s == LW.addExtension p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.addExtension p s == LW.addExtension p s
     )
     ,
     ( "hasExtension (windows)"
-    , property $ \p -> W.hasExtension p == LW.hasExtension p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.hasExtension p == LW.hasExtension p
     )
     ,
     ( "splitExtensions (windows)"
-    , property $ \p -> W.splitExtensions p == LW.splitExtensions p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.splitExtensions p == LW.splitExtensions p
     )
     ,
     ( "dropExtensions (windows)"
-    , property $ \p -> W.dropExtensions p == LW.dropExtensions p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.dropExtensions p == LW.dropExtensions p
     )
     ,
     ( "takeExtensions (windows)"
@@ -89,107 +267,105 @@ equivalentTests =
     )
     ,
     ( "replaceExtensions (windows)"
-    , property $ \p s -> W.replaceExtensions p s == LW.replaceExtensions p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceExtensions p s == LW.replaceExtensions p s
     )
     ,
     ( "isExtensionOf (windows)"
-    , property $ \p s -> W.isExtensionOf p s == LW.isExtensionOf p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.isExtensionOf p s == LW.isExtensionOf p s
     )
     ,
     ( "stripExtension (windows)"
-    , property $ \p s -> W.stripExtension p s == LW.stripExtension p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.stripExtension p s == LW.stripExtension p s
     )
     ,
     ( "splitFileName (windows)"
-    , property $ \p -> W.splitFileName p == LW.splitFileName p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.splitFileName p == LW.splitFileName p
     )
     ,
     ( "takeFileName (windows)"
-    , property $ \p -> W.takeFileName p == LW.takeFileName p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.takeFileName p == LW.takeFileName p
     )
     ,
     ( "replaceFileName (windows)"
-    , property $ \p s -> W.replaceFileName p s == LW.replaceFileName p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceFileName p s == LW.replaceFileName p s
     )
     ,
     ( "dropFileName (windows)"
-    , property $ \p -> W.dropFileName p == LW.dropFileName p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.dropFileName p == LW.dropFileName p
     )
     ,
     ( "takeBaseName (windows)"
-    , property $ \p -> W.takeBaseName p == LW.takeBaseName p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.takeBaseName p == LW.takeBaseName p
     )
     ,
     ( "replaceBaseName (windows)"
-    , property $ \p s -> W.replaceBaseName p s == LW.replaceBaseName p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceBaseName p s == LW.replaceBaseName p s
     )
     ,
     ( "takeDirectory (windows)"
-    , property $ \p -> W.takeDirectory p == LW.takeDirectory p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.takeDirectory p == LW.takeDirectory p
     )
     ,
     ( "replaceDirectory (windows)"
-    , property $ \p s -> W.replaceDirectory p s == LW.replaceDirectory p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceDirectory p s == LW.replaceDirectory p s
     )
     ,
     ( "combine (windows)"
-    , property $ \p s -> W.combine p s == LW.combine p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.combine p s == LW.combine p s
     )
     ,
     ( "splitPath (windows)"
-    , property $ \p -> W.splitPath p == LW.splitPath p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.splitPath p == LW.splitPath p
     )
     ,
     ( "joinPath (windows)"
-    , property $ \p -> W.joinPath p == LW.joinPath p
-    )
-    ,
-    ( "splitDirectories (windows)"
-    , property $ \p -> W.splitDirectories p == LW.splitDirectories p
+    , property $ \(xs :: WindowsFilePaths) ->
+       let p = altShow <$> unWindowsFilePaths xs
+       in W.joinPath p == LW.joinPath p
     )
     ,
     ( "splitDirectories (windows)"
-    , property $ \p -> W.splitDirectories p == LW.splitDirectories p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.splitDirectories p == LW.splitDirectories p
     )
     ,
     ( "splitDrive (windows)"
-    , property $ \p -> W.splitDrive p == LW.splitDrive p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.splitDrive p == LW.splitDrive p
     )
     ,
     ( "joinDrive (windows)"
-    , property $ \p s -> W.joinDrive p s == LW.joinDrive p s
+    , property $ \(altShow @WindowsFilePath -> p) s -> W.joinDrive p s == LW.joinDrive p s
     )
     ,
     ( "takeDrive (windows)"
-    , property $ \p -> W.takeDrive p == LW.takeDrive p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.takeDrive p == LW.takeDrive p
     )
     ,
     ( "hasDrive (windows)"
-    , property $ \p -> W.hasDrive p == LW.hasDrive p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.hasDrive p == LW.hasDrive p
     )
     ,
     ( "dropDrive (windows)"
-    , property $ \p -> W.dropDrive p == LW.dropDrive p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.dropDrive p == LW.dropDrive p
     )
     ,
     ( "isDrive (windows)"
-    , property $ \p -> W.isDrive p == LW.isDrive p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.isDrive p == LW.isDrive p
     )
     ,
     ( "hasTrailingPathSeparator (windows)"
-    , property $ \p -> W.hasTrailingPathSeparator p == LW.hasTrailingPathSeparator p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.hasTrailingPathSeparator p == LW.hasTrailingPathSeparator p
     )
     ,
     ( "addTrailingPathSeparator (windows)"
-    , property $ \p -> W.addTrailingPathSeparator p == LW.addTrailingPathSeparator p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.addTrailingPathSeparator p == LW.addTrailingPathSeparator p
     )
     ,
     ( "dropTrailingPathSeparator (windows)"
-    , property $ \p -> W.dropTrailingPathSeparator p == LW.dropTrailingPathSeparator p
+    , property $ \(altShow @WindowsFilePath -> p) -> W.dropTrailingPathSeparator p == LW.dropTrailingPathSeparator p
     )
     ,
     ( "normalise (windows)"
-    , property $ \p -> case p of
+    , property $ \(altShow @WindowsFilePath -> p) -> case p of
                          (l:':':rs)
                            -- new filepath normalises "a:////////" to "A:\\"
                            -- see https://github.com/haskell/filepath/commit/cb4890aa03a5ee61f16f7a08dd2d964fffffb385
diff --git a/tests/filepath-tests/TestGen.hs b/tests/filepath-tests/TestGen.hs
index 8f26f2b41fc5665943deb298d0f1eb77b06078d8..1d75b032dc383e73fb0b2dec2e5b410004400a07 100755
--- a/tests/filepath-tests/TestGen.hs
+++ b/tests/filepath-tests/TestGen.hs
@@ -458,6 +458,8 @@ tests =
     ,("AFP_W.splitFileName (\"c:\") == ((\"c:\"), (\"\"))", property $ AFP_W.splitFileName ("c:") == (("c:"), ("")))
     ,("W.splitFileName \"\\\\\\\\?\\\\A:\\\\fred\" == (\"\\\\\\\\?\\\\A:\\\\\", \"fred\")", property $ W.splitFileName "\\\\?\\A:\\fred" == ("\\\\?\\A:\\", "fred"))
     ,("AFP_W.splitFileName (\"\\\\\\\\?\\\\A:\\\\fred\") == ((\"\\\\\\\\?\\\\A:\\\\\"), (\"fred\"))", property $ AFP_W.splitFileName ("\\\\?\\A:\\fred") == (("\\\\?\\A:\\"), ("fred")))
+    ,("W.splitFileName \"\\\\\\\\?\\\\A:\" == (\"\\\\\\\\?\\\\A:\", \"\")", property $ W.splitFileName "\\\\?\\A:" == ("\\\\?\\A:", ""))
+    ,("AFP_W.splitFileName (\"\\\\\\\\?\\\\A:\") == ((\"\\\\\\\\?\\\\A:\"), (\"\"))", property $ AFP_W.splitFileName ("\\\\?\\A:") == (("\\\\?\\A:"), ("")))
     ,("P.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ P.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext")
     ,("W.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ W.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext")
     ,("AFP_P.replaceFileName (\"/directory/other.txt\") (\"file.ext\") == (\"/directory/file.ext\")", property $ AFP_P.replaceFileName ("/directory/other.txt") ("file.ext") == ("/directory/file.ext"))
@@ -474,6 +476,10 @@ tests =
     ,("W.dropFileName x == fst (W.splitFileName x)", property $ \(QFilePath x) -> W.dropFileName x == fst (W.splitFileName x))
     ,("AFP_P.dropFileName x == fst (AFP_P.splitFileName x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropFileName x == fst (AFP_P.splitFileName x))
     ,("AFP_W.dropFileName x == fst (AFP_W.splitFileName x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropFileName x == fst (AFP_W.splitFileName x))
+    ,("isPrefixOf (P.takeDrive x) (P.dropFileName x)", property $ \(QFilePath x) -> isPrefixOf (P.takeDrive x) (P.dropFileName x))
+    ,("isPrefixOf (W.takeDrive x) (W.dropFileName x)", property $ \(QFilePath x) -> isPrefixOf (W.takeDrive x) (W.dropFileName x))
+    ,("(\\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDrive x) (AFP_P.dropFileName x)", property $ \(QFilePathAFP_P x) -> (\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDrive x) (AFP_P.dropFileName x))
+    ,("(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDrive x) (AFP_W.dropFileName x)", property $ \(QFilePathAFP_W x) -> (\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDrive x) (AFP_W.dropFileName x))
     ,("P.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ P.takeFileName "/directory/file.ext" == "file.ext")
     ,("W.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ W.takeFileName "/directory/file.ext" == "file.ext")
     ,("AFP_P.takeFileName (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_P.takeFileName ("/directory/file.ext") == ("file.ext"))