-- Do not edit! Automatically created with doctest-extract from src/System/Path/Internal.hs {-# LINE 196 "src/System/Path/Internal.hs" #-} {-# OPTIONS_GHC -XTypeFamilies #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Test.Windows.System.Path.Internal where import qualified System.Path.Windows as Default import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest {-# LINE 200 "src/System/Path/Internal.hs" #-} import qualified System.Path.PartClass as Class import qualified System.Path.Generic as Path import qualified System.Path.Posix as Posix import qualified System.Path.Windows as Windows import System.Path.Generic ((), (<.>), relFile, relDir, absFile, absDir) import Data.List (isSuffixOf, isPrefixOf) import Data.Char (toLower) import qualified Test.QuickCheck as QC forAllAbsRel :: (Class.FileDir fd, QC.Testable prop) => (Default.AbsRel fd -> prop) -> QC.Property forAllAbsRel = QC.forAll QC.arbitrary test :: DocTest.T () test = do DocTest.printPrefix "System.Path.Internal:280: " {-# LINE 280 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 280 "src/System/Path/Internal.hs" #-} (Path.pathMap (map toLower) (absDir "/tmp/Reports/SpreadSheets") == Posix.absDir "/tmp/reports/spreadsheets") DocTest.printPrefix "System.Path.Internal:353: " {-# LINE 353 "src/System/Path/Internal.hs" #-} DocTest.example {-# LINE 353 "src/System/Path/Internal.hs" #-} (Posix.rootDir relDir "bla" relFile "blub") [ExpectedLine [LineChunk "rootDir relPath \"bla\" relPath \"blub\""]] DocTest.printPrefix "System.Path.Internal:355: " {-# LINE 355 "src/System/Path/Internal.hs" #-} DocTest.example {-# LINE 355 "src/System/Path/Internal.hs" #-} (Just (Posix.rootDir relDir "bla" relFile "blub")) [ExpectedLine [LineChunk "Just (rootDir relPath \"bla\" relPath \"blub\")"]] DocTest.printPrefix "System.Path.Internal:357: " {-# LINE 357 "src/System/Path/Internal.hs" #-} DocTest.example {-# LINE 357 "src/System/Path/Internal.hs" #-} (Posix.currentDir relDir "bla" relFile "blub") [ExpectedLine [LineChunk "currentDir relPath \"bla\" relPath \"blub\""]] DocTest.printPrefix "System.Path.Internal:359: " {-# LINE 359 "src/System/Path/Internal.hs" #-} DocTest.example {-# LINE 359 "src/System/Path/Internal.hs" #-} (Just (Posix.currentDir relDir "bla" relFile "blub")) [ExpectedLine [LineChunk "Just (currentDir relPath \"bla\" relPath \"blub\")"]] DocTest.printPrefix "System.Path.Internal:361: " {-# LINE 361 "src/System/Path/Internal.hs" #-} DocTest.example {-# LINE 361 "src/System/Path/Internal.hs" #-} (Windows.absDir "c:" relDir "bla" relFile "blub") [ExpectedLine [LineChunk "absDir \"c:\" relPath \"bla\" relPath \"blub\""]] DocTest.printPrefix "System.Path.Internal:363: " {-# LINE 363 "src/System/Path/Internal.hs" #-} DocTest.example {-# LINE 363 "src/System/Path/Internal.hs" #-} (Just (Windows.absDir "c:\\" relDir "bla" relFile "blub")) [ExpectedLine [LineChunk "Just (absDir \"c:\\\\\" relPath \"bla\" relPath \"blub\")"]] DocTest.printPrefix "System.Path.Internal:475: " {-# LINE 475 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 475 "src/System/Path/Internal.hs" #-} (\p -> Path.asPath (Path.toString p) == (p::Default.AbsFile)) DocTest.printPrefix "System.Path.Internal:557: " {-# LINE 557 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 557 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/") DocTest.printPrefix "System.Path.Internal:558: " {-# LINE 558 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 558 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing) DocTest.printPrefix "System.Path.Internal:559: " {-# LINE 559 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 559 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing) DocTest.printPrefix "System.Path.Internal:560: " {-# LINE 560 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 560 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing) DocTest.printPrefix "System.Path.Internal:561: " {-# LINE 561 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 561 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp") DocTest.printPrefix "System.Path.Internal:562: " {-# LINE 562 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 562 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp") DocTest.printPrefix "System.Path.Internal:563: " {-# LINE 563 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 563 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing) DocTest.printPrefix "System.Path.Internal:564: " {-# LINE 564 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 564 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing) DocTest.printPrefix "System.Path.Internal:565: " {-# LINE 565 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 565 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp") DocTest.printPrefix "System.Path.Internal:566: " {-# LINE 566 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 566 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing) DocTest.printPrefix "System.Path.Internal:567: " {-# LINE 567 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 567 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing) DocTest.printPrefix "System.Path.Internal:568: " {-# LINE 568 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 568 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing) DocTest.printPrefix "System.Path.Internal:569: " {-# LINE 569 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 569 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsRelFileDir) == Just "/tmp") DocTest.printPrefix "System.Path.Internal:570: " {-# LINE 570 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 570 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsRelFileDir) == Just "/tmp") DocTest.printPrefix "System.Path.Internal:571: " {-# LINE 571 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 571 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt") DocTest.printPrefix "System.Path.Internal:572: " {-# LINE 572 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 572 "src/System/Path/Internal.hs" #-} (fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing) DocTest.printPrefix "System.Path.Internal:573: " {-# LINE 573 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 573 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp") DocTest.printPrefix "System.Path.Internal:574: " {-# LINE 574 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 574 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp") DocTest.printPrefix "System.Path.Internal:575: " {-# LINE 575 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 575 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp") DocTest.printPrefix "System.Path.Internal:576: " {-# LINE 576 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 576 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\") DocTest.printPrefix "System.Path.Internal:577: " {-# LINE 577 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 577 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:") DocTest.printPrefix "System.Path.Internal:578: " {-# LINE 578 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 578 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp") DocTest.printPrefix "System.Path.Internal:579: " {-# LINE 579 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 579 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing) DocTest.printPrefix "System.Path.Internal:580: " {-# LINE 580 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 580 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing) DocTest.printPrefix "System.Path.Internal:581: " {-# LINE 581 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 581 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing) DocTest.printPrefix "System.Path.Internal:582: " {-# LINE 582 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 582 "src/System/Path/Internal.hs" #-} (fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing) DocTest.printPrefix "System.Path.Internal:631: " {-# LINE 631 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 631 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.relFile "file.txt") == "file.txt") DocTest.printPrefix "System.Path.Internal:632: " {-# LINE 632 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 632 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.relFile "tmp") == "tmp") DocTest.printPrefix "System.Path.Internal:638: " {-# LINE 638 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 638 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.relDir ".") == ".") DocTest.printPrefix "System.Path.Internal:639: " {-# LINE 639 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 639 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.relDir "file.txt") == "file.txt") DocTest.printPrefix "System.Path.Internal:640: " {-# LINE 640 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 640 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.relDir "tmp") == "tmp") DocTest.printPrefix "System.Path.Internal:646: " {-# LINE 646 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 646 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.absFile "/file.txt") == "/file.txt") DocTest.printPrefix "System.Path.Internal:647: " {-# LINE 647 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 647 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.absFile "/tmp") == "/tmp") DocTest.printPrefix "System.Path.Internal:653: " {-# LINE 653 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 653 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.absDir "/file.txt") == "/file.txt") DocTest.printPrefix "System.Path.Internal:654: " {-# LINE 654 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 654 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.absDir "/tmp") == "/tmp") DocTest.printPrefix "System.Path.Internal:749: " {-# LINE 749 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 749 "src/System/Path/Internal.hs" #-} (Posix.asPath "/tmp" == Posix.absDir "/tmp") DocTest.printPrefix "System.Path.Internal:750: " {-# LINE 750 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 750 "src/System/Path/Internal.hs" #-} (Posix.asPath "file.txt" == Posix.relFile "file.txt") DocTest.printPrefix "System.Path.Internal:751: " {-# LINE 751 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 751 "src/System/Path/Internal.hs" #-} (Path.isAbsolute (Posix.asAbsDir "/tmp")) DocTest.printPrefix "System.Path.Internal:752: " {-# LINE 752 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 752 "src/System/Path/Internal.hs" #-} (Path.isRelative (Posix.asRelDir "/tmp")) DocTest.printPrefix "System.Path.Internal:753: " {-# LINE 753 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 753 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp") DocTest.printPrefix "System.Path.Internal:754: " {-# LINE 754 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 754 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp") DocTest.printPrefix "System.Path.Internal:755: " {-# LINE 755 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 755 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp") DocTest.printPrefix "System.Path.Internal:756: " {-# LINE 756 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 756 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp") DocTest.printPrefix "System.Path.Internal:757: " {-# LINE 757 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 757 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.asPath "a:tmp" :: Windows.AbsDir) == "a:tmp") DocTest.printPrefix "System.Path.Internal:758: " {-# LINE 758 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 758 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp") DocTest.printPrefix "System.Path.Internal:766: " {-# LINE 766 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 766 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asRelFile "file.txt") == "file.txt") DocTest.printPrefix "System.Path.Internal:767: " {-# LINE 767 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 767 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asRelFile "/file.txt") == "file.txt") DocTest.printPrefix "System.Path.Internal:768: " {-# LINE 768 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 768 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asRelFile "tmp") == "tmp") DocTest.printPrefix "System.Path.Internal:769: " {-# LINE 769 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 769 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asRelFile "/tmp") == "tmp") DocTest.printPrefix "System.Path.Internal:775: " {-# LINE 775 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 775 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asRelDir ".") == ".") DocTest.printPrefix "System.Path.Internal:776: " {-# LINE 776 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 776 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asRelDir "file.txt") == "file.txt") DocTest.printPrefix "System.Path.Internal:777: " {-# LINE 777 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 777 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asRelDir "/file.txt") == "file.txt") DocTest.printPrefix "System.Path.Internal:778: " {-# LINE 778 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 778 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asRelDir "tmp") == "tmp") DocTest.printPrefix "System.Path.Internal:779: " {-# LINE 779 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 779 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asRelDir "/tmp") == "tmp") DocTest.printPrefix "System.Path.Internal:785: " {-# LINE 785 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 785 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asAbsFile "/file.txt") == "/file.txt") DocTest.printPrefix "System.Path.Internal:786: " {-# LINE 786 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 786 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asAbsFile "/tmp") == "/tmp") DocTest.printPrefix "System.Path.Internal:792: " {-# LINE 792 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 792 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asAbsDir "/file.txt") == "/file.txt") DocTest.printPrefix "System.Path.Internal:793: " {-# LINE 793 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 793 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.asAbsDir "/tmp") == "/tmp") DocTest.printPrefix "System.Path.Internal:832: " {-# LINE 832 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 832 "src/System/Path/Internal.hs" #-} (Path.mkPathAbsOrRel "/tmp" == Left (Posix.absDir "/tmp")) DocTest.printPrefix "System.Path.Internal:833: " {-# LINE 833 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 833 "src/System/Path/Internal.hs" #-} (Path.mkPathAbsOrRel "tmp" == Right (Posix.relDir "tmp")) DocTest.printPrefix "System.Path.Internal:834: " {-# LINE 834 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 834 "src/System/Path/Internal.hs" #-} (Path.mkPathAbsOrRel "\\tmp" == Left (Windows.absDir "\\tmp")) DocTest.printPrefix "System.Path.Internal:835: " {-# LINE 835 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 835 "src/System/Path/Internal.hs" #-} (Path.mkPathAbsOrRel "d:\\tmp" == Left (Windows.absDir "d:\\tmp")) DocTest.printPrefix "System.Path.Internal:836: " {-# LINE 836 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 836 "src/System/Path/Internal.hs" #-} (Path.mkPathAbsOrRel "d:tmp" == Left (Windows.absDir "d:tmp")) DocTest.printPrefix "System.Path.Internal:837: " {-# LINE 837 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 837 "src/System/Path/Internal.hs" #-} (Path.mkPathAbsOrRel "tmp" == Right (Windows.relDir "tmp")) DocTest.printPrefix "System.Path.Internal:866: " {-# LINE 866 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 866 "src/System/Path/Internal.hs" #-} (Path.mkAbsPath (absDir "/tmp") "foo.txt" == Posix.absFile "/tmp/foo.txt") DocTest.printPrefix "System.Path.Internal:867: " {-# LINE 867 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 867 "src/System/Path/Internal.hs" #-} (Path.mkAbsPath (absDir "/tmp") "/etc/foo.txt" == Posix.absFile "/etc/foo.txt") DocTest.printPrefix "System.Path.Internal:1007: " {-# LINE 1007 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1007 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.absDir "/tmp" Posix.relFile "file.txt") == "/tmp/file.txt") DocTest.printPrefix "System.Path.Internal:1008: " {-# LINE 1008 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1008 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.absDir "/tmp" Posix.relDir "dir" Posix.relFile "file.txt") == "/tmp/dir/file.txt") DocTest.printPrefix "System.Path.Internal:1009: " {-# LINE 1009 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1009 "src/System/Path/Internal.hs" #-} (Posix.toString (Posix.relDir "dir" Posix.relFile "file.txt") == "dir/file.txt") DocTest.printPrefix "System.Path.Internal:1010: " {-# LINE 1010 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1010 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.absDir "\\tmp" Windows.relFile "file.txt") == "\\tmp\\file.txt") DocTest.printPrefix "System.Path.Internal:1011: " {-# LINE 1011 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1011 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.absDir "c:\\tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt") DocTest.printPrefix "System.Path.Internal:1012: " {-# LINE 1012 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1012 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.absDir "c:tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt") DocTest.printPrefix "System.Path.Internal:1013: " {-# LINE 1013 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1013 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.absDir "c:\\" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:\\tmp\\file.txt") DocTest.printPrefix "System.Path.Internal:1014: " {-# LINE 1014 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1014 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.absDir "c:" Windows.relDir "tmp" Windows.relFile "file.txt") == "c:tmp\\file.txt") DocTest.printPrefix "System.Path.Internal:1015: " {-# LINE 1015 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1015 "src/System/Path/Internal.hs" #-} (Windows.toString (Windows.relDir "dir" Windows.relFile "file.txt") == "dir\\file.txt") DocTest.printPrefix "System.Path.Internal:1042: " {-# LINE 1042 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1042 "src/System/Path/Internal.hs" #-} (Path.addExtension (relFile "file.txt") "bib" == Posix.relFile "file.txt.bib") DocTest.printPrefix "System.Path.Internal:1043: " {-# LINE 1043 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1043 "src/System/Path/Internal.hs" #-} (Path.addExtension (relFile "file.") ".bib" == Posix.relFile "file..bib") DocTest.printPrefix "System.Path.Internal:1044: " {-# LINE 1044 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1044 "src/System/Path/Internal.hs" #-} (Path.addExtension (relFile "file") ".bib" == Posix.relFile "file.bib") DocTest.printPrefix "System.Path.Internal:1045: " {-# LINE 1045 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1045 "src/System/Path/Internal.hs" #-} (Path.addExtension Path.emptyFile "bib" == Posix.relFile ".bib") DocTest.printPrefix "System.Path.Internal:1046: " {-# LINE 1046 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1046 "src/System/Path/Internal.hs" #-} (Path.addExtension Path.emptyFile ".bib" == Posix.relFile ".bib") DocTest.printPrefix "System.Path.Internal:1047: " {-# LINE 1047 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1047 "src/System/Path/Internal.hs" #-} (Path.takeFileName (Path.addExtension Path.emptyFile "ext") == Posix.relFile ".ext") DocTest.printPrefix "System.Path.Internal:1054: " {-# LINE 1054 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1054 "src/System/Path/Internal.hs" #-} (\p -> Path.combine Path.currentDir p == (p::Default.RelDir)) DocTest.printPrefix "System.Path.Internal:1061: " {-# LINE 1061 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1061 "src/System/Path/Internal.hs" #-} (forAllAbsRel $ \x -> Path.dropExtension x == fst (Path.splitExtension x)) DocTest.printPrefix "System.Path.Internal:1067: " {-# LINE 1067 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1067 "src/System/Path/Internal.hs" #-} (forAllAbsRel $ \x -> not $ Path.hasAnExtension (Path.dropExtensions x)) DocTest.printPrefix "System.Path.Internal:1078: " {-# LINE 1078 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1078 "src/System/Path/Internal.hs" #-} (Path.replaceExtension (relFile "file.txt") ".bob" == Posix.relFile "file.bob") DocTest.printPrefix "System.Path.Internal:1079: " {-# LINE 1079 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1079 "src/System/Path/Internal.hs" #-} (Path.replaceExtension (relFile "file.txt") "bob" == Posix.relFile "file.bob") DocTest.printPrefix "System.Path.Internal:1080: " {-# LINE 1080 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1080 "src/System/Path/Internal.hs" #-} (Path.replaceExtension (relFile "file") ".bob" == Posix.relFile "file.bob") DocTest.printPrefix "System.Path.Internal:1081: " {-# LINE 1081 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1081 "src/System/Path/Internal.hs" #-} (Path.replaceExtension (relFile "file.txt") "" == Posix.relFile "file") DocTest.printPrefix "System.Path.Internal:1082: " {-# LINE 1082 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1082 "src/System/Path/Internal.hs" #-} (Path.replaceExtension (relFile "file.fred.bob") "txt" == Posix.relFile "file.fred.txt") DocTest.printPrefix "System.Path.Internal:1099: " {-# LINE 1099 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1099 "src/System/Path/Internal.hs" #-} (forAllAbsRel $ \x -> uncurry (<.>) (Path.splitExtension x) == x) DocTest.printPrefix "System.Path.Internal:1100: " {-# LINE 1100 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1100 "src/System/Path/Internal.hs" #-} (forAllAbsRel $ \x -> uncurry Path.addExtension (Path.splitExtension x) == x) DocTest.printPrefix "System.Path.Internal:1101: " {-# LINE 1101 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1101 "src/System/Path/Internal.hs" #-} (Path.splitExtension (relFile "file.txt") == (Posix.relFile "file",".txt")) DocTest.printPrefix "System.Path.Internal:1102: " {-# LINE 1102 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1102 "src/System/Path/Internal.hs" #-} (Path.splitExtension (relFile ".bashrc") == (Posix.emptyFile, ".bashrc")) DocTest.printPrefix "System.Path.Internal:1103: " {-# LINE 1103 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1103 "src/System/Path/Internal.hs" #-} (Path.splitExtension (relFile "file") == (Posix.relFile "file","")) DocTest.printPrefix "System.Path.Internal:1104: " {-# LINE 1104 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1104 "src/System/Path/Internal.hs" #-} (Path.splitExtension (relFile "file/file.txt") == (Posix.relFile "file/file",".txt")) DocTest.printPrefix "System.Path.Internal:1105: " {-# LINE 1105 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1105 "src/System/Path/Internal.hs" #-} (Path.splitExtension (relFile "file.txt/boris") == (Posix.relFile "file.txt/boris","")) DocTest.printPrefix "System.Path.Internal:1106: " {-# LINE 1106 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1106 "src/System/Path/Internal.hs" #-} (Path.splitExtension (relFile "file.txt/boris.ext") == (Posix.relFile "file.txt/boris",".ext")) DocTest.printPrefix "System.Path.Internal:1107: " {-# LINE 1107 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1107 "src/System/Path/Internal.hs" #-} (Path.splitExtension (relFile "file/path.txt.bob.fred") == (Posix.relFile "file/path.txt.bob",".fred")) DocTest.printPrefix "System.Path.Internal:1113: " {-# LINE 1113 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1113 "src/System/Path/Internal.hs" #-} (Path.splitExtensions (relFile "file.tar.gz") == (Posix.relFile "file",".tar.gz")) DocTest.printPrefix "System.Path.Internal:1114: " {-# LINE 1114 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1114 "src/System/Path/Internal.hs" #-} (\p -> uncurry (<.>) (Path.splitExtension p) == (p::Default.AbsFile)) DocTest.printPrefix "System.Path.Internal:1118: " {-# LINE 1118 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1118 "src/System/Path/Internal.hs" #-} (\p -> uncurry Path.combine (Path.splitFileName p) == (p::Default.AbsFile)) DocTest.printPrefix "System.Path.Internal:1134: " {-# LINE 1134 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1134 "src/System/Path/Internal.hs" #-} (Path.takeBaseName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile") DocTest.printPrefix "System.Path.Internal:1135: " {-# LINE 1135 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1135 "src/System/Path/Internal.hs" #-} (Path.takeBaseName (relFile "./myfile.txt") == Posix.relFile "myfile") DocTest.printPrefix "System.Path.Internal:1136: " {-# LINE 1136 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1136 "src/System/Path/Internal.hs" #-} (Path.takeBaseName (relFile "myfile.txt") == Posix.relFile "myfile") DocTest.printPrefix "System.Path.Internal:1155: " {-# LINE 1155 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1155 "src/System/Path/Internal.hs" #-} (forAllAbsRel $ \x -> Path.takeExtension x == snd (Path.splitExtension x)) DocTest.printPrefix "System.Path.Internal:1156: " {-# LINE 1156 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1156 "src/System/Path/Internal.hs" #-} (forAllAbsRel $ \x -> Path.takeExtension (Path.addExtension x "ext") == ".ext") DocTest.printPrefix "System.Path.Internal:1157: " {-# LINE 1157 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1157 "src/System/Path/Internal.hs" #-} (forAllAbsRel $ \x -> Path.takeExtension (Path.replaceExtension x "ext") == ".ext") DocTest.printPrefix "System.Path.Internal:1163: " {-# LINE 1163 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1163 "src/System/Path/Internal.hs" #-} (Path.takeExtensions (Posix.relFile "file.tar.gz") == ".tar.gz") DocTest.printPrefix "System.Path.Internal:1169: " {-# LINE 1169 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1169 "src/System/Path/Internal.hs" #-} (Path.takeFileName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile.txt") DocTest.printPrefix "System.Path.Internal:1170: " {-# LINE 1170 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1170 "src/System/Path/Internal.hs" #-} (Path.takeFileName (relFile "./myfile.txt") == Posix.relFile "myfile.txt") DocTest.printPrefix "System.Path.Internal:1171: " {-# LINE 1171 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1171 "src/System/Path/Internal.hs" #-} (Path.takeFileName (relFile "myfile.txt") == Posix.relFile "myfile.txt") DocTest.printPrefix "System.Path.Internal:1172: " {-# LINE 1172 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1172 "src/System/Path/Internal.hs" #-} (\p -> Path.toString (Path.takeFileName p) `isSuffixOf` Path.toString (p::Default.AbsFile)) DocTest.printPrefix "System.Path.Internal:1201: " {-# LINE 1201 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1201 "src/System/Path/Internal.hs" #-} (Posix.equalFilePath "abc/def" "abc/def") DocTest.printPrefix "System.Path.Internal:1202: " {-# LINE 1202 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1202 "src/System/Path/Internal.hs" #-} (Posix.equalFilePath "abc/def" "abc//def") DocTest.printPrefix "System.Path.Internal:1203: " {-# LINE 1203 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1203 "src/System/Path/Internal.hs" #-} (Posix.equalFilePath "/tmp/" "/tmp") DocTest.printPrefix "System.Path.Internal:1204: " {-# LINE 1204 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1204 "src/System/Path/Internal.hs" #-} (Posix.equalFilePath "/tmp" "//tmp") DocTest.printPrefix "System.Path.Internal:1205: " {-# LINE 1205 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1205 "src/System/Path/Internal.hs" #-} (Posix.equalFilePath "/tmp" "///tmp") DocTest.printPrefix "System.Path.Internal:1206: " {-# LINE 1206 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1206 "src/System/Path/Internal.hs" #-} (not $ Posix.equalFilePath "abc" "def") DocTest.printPrefix "System.Path.Internal:1207: " {-# LINE 1207 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1207 "src/System/Path/Internal.hs" #-} (not $ Posix.equalFilePath "/tmp" "tmp") DocTest.printPrefix "System.Path.Internal:1208: " {-# LINE 1208 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1208 "src/System/Path/Internal.hs" #-} (Windows.equalFilePath "abc\\def" "abc\\def") DocTest.printPrefix "System.Path.Internal:1209: " {-# LINE 1209 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1209 "src/System/Path/Internal.hs" #-} (Windows.equalFilePath "abc\\def" "abc\\\\def") DocTest.printPrefix "System.Path.Internal:1210: " {-# LINE 1210 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1210 "src/System/Path/Internal.hs" #-} (Windows.equalFilePath "file" "File") DocTest.printPrefix "System.Path.Internal:1211: " {-# LINE 1211 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1211 "src/System/Path/Internal.hs" #-} (Windows.equalFilePath "\\file" "\\\\file") DocTest.printPrefix "System.Path.Internal:1212: " {-# LINE 1212 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1212 "src/System/Path/Internal.hs" #-} (Windows.equalFilePath "\\file" "\\\\\\file") DocTest.printPrefix "System.Path.Internal:1213: " {-# LINE 1213 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1213 "src/System/Path/Internal.hs" #-} (not $ Windows.equalFilePath "abc" "def") DocTest.printPrefix "System.Path.Internal:1214: " {-# LINE 1214 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1214 "src/System/Path/Internal.hs" #-} (not $ Windows.equalFilePath "file" "dir") DocTest.printPrefix "System.Path.Internal:1227: " {-# LINE 1227 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1227 "src/System/Path/Internal.hs" #-} (Path.joinPath ["tmp","someDir","dir"] == Posix.relDir "tmp/someDir/dir") DocTest.printPrefix "System.Path.Internal:1228: " {-# LINE 1228 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1228 "src/System/Path/Internal.hs" #-} (Path.joinPath ["tmp","someDir","file.txt"] == Posix.relFile "tmp/someDir/file.txt") DocTest.printPrefix "System.Path.Internal:1234: " {-# LINE 1234 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1234 "src/System/Path/Internal.hs" #-} (Path.normalise (absFile "/tmp/fred/./jim/./file") == Posix.absFile "/tmp/fred/jim/file") DocTest.printPrefix "System.Path.Internal:1240: " {-# LINE 1240 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1240 "src/System/Path/Internal.hs" #-} (Path.splitPath (Posix.absDir "/tmp/someDir/mydir.dir") == (True, map relDir ["tmp","someDir","mydir.dir"], Nothing)) DocTest.printPrefix "System.Path.Internal:1241: " {-# LINE 1241 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1241 "src/System/Path/Internal.hs" #-} (Path.splitPath (Posix.absFile "/tmp/someDir/myfile.txt") == (True, map relDir ["tmp","someDir"], Just $ relFile "myfile.txt")) DocTest.printPrefix "System.Path.Internal:1257: " {-# LINE 1257 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1257 "src/System/Path/Internal.hs" #-} (Path.makeRelative (absDir "/tmp/somedir") (absFile "/tmp/somedir/anotherdir/file.txt") == Posix.relFile "anotherdir/file.txt") DocTest.printPrefix "System.Path.Internal:1258: " {-# LINE 1258 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1258 "src/System/Path/Internal.hs" #-} (Path.makeRelative (absDir "/tmp/somedir") (absDir "/tmp/somedir/anotherdir/dir") == Posix.relDir "anotherdir/dir") DocTest.printPrefix "System.Path.Internal:1259: " {-# LINE 1259 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1259 "src/System/Path/Internal.hs" #-} (Path.makeRelative (absDir "c:\\tmp\\somedir") (absFile "C:\\Tmp\\SomeDir\\AnotherDir\\File.txt") == Windows.relFile "AnotherDir\\File.txt") DocTest.printPrefix "System.Path.Internal:1260: " {-# LINE 1260 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1260 "src/System/Path/Internal.hs" #-} (Path.makeRelative (absDir "c:\\tmp\\somedir") (absDir "c:\\tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir") DocTest.printPrefix "System.Path.Internal:1261: " {-# LINE 1261 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1261 "src/System/Path/Internal.hs" #-} (Path.makeRelative (absDir "c:tmp\\somedir") (absDir "c:tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir") DocTest.printPrefix "System.Path.Internal:1288: " {-# LINE 1288 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1288 "src/System/Path/Internal.hs" #-} (Path.makeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt") DocTest.printPrefix "System.Path.Internal:1289: " {-# LINE 1289 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1289 "src/System/Path/Internal.hs" #-} (Path.makeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt") DocTest.printPrefix "System.Path.Internal:1290: " {-# LINE 1290 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1290 "src/System/Path/Internal.hs" #-} (Path.makeAbsolute (absDir "/tmp") (relDir "adir/dir") == Posix.absDir "/tmp/adir/dir") DocTest.printPrefix "System.Path.Internal:1291: " {-# LINE 1291 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1291 "src/System/Path/Internal.hs" #-} (\base p -> Default.toString p `isSuffixOf` Path.toString (Path.makeAbsolute base (Path.idFile p))) DocTest.printPrefix "System.Path.Internal:1292: " {-# LINE 1292 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1292 "src/System/Path/Internal.hs" #-} (\base p -> Default.toString base `isPrefixOf` Path.toString (Path.makeAbsolute base (Path.idFile p))) DocTest.printPrefix "System.Path.Internal:1314: " {-# LINE 1314 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1314 "src/System/Path/Internal.hs" #-} (Path.genericMakeAbsolute (absDir "/tmp") (relFile "file.txt") == Posix.absFile "/tmp/file.txt") DocTest.printPrefix "System.Path.Internal:1315: " {-# LINE 1315 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1315 "src/System/Path/Internal.hs" #-} (Path.genericMakeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt") DocTest.printPrefix "System.Path.Internal:1316: " {-# LINE 1316 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1316 "src/System/Path/Internal.hs" #-} (Path.genericMakeAbsolute (absDir "/tmp") (absFile "/adir/file.txt") == Posix.absFile "/adir/file.txt") DocTest.printPrefix "System.Path.Internal:1401: " {-# LINE 1401 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1401 "src/System/Path/Internal.hs" #-} (Path.isAbsolute (Posix.absFile "/fred")) DocTest.printPrefix "System.Path.Internal:1402: " {-# LINE 1402 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1402 "src/System/Path/Internal.hs" #-} (Path.isAbsolute (Windows.absFile "\\fred")) DocTest.printPrefix "System.Path.Internal:1403: " {-# LINE 1403 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1403 "src/System/Path/Internal.hs" #-} (Path.isAbsolute (Windows.absFile "c:\\fred")) DocTest.printPrefix "System.Path.Internal:1404: " {-# LINE 1404 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1404 "src/System/Path/Internal.hs" #-} (Path.isAbsolute (Windows.absFile "c:fred")) DocTest.printPrefix "System.Path.Internal:1411: " {-# LINE 1411 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1411 "src/System/Path/Internal.hs" #-} (Path.isRelative (Posix.relFile "fred")) DocTest.printPrefix "System.Path.Internal:1412: " {-# LINE 1412 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1412 "src/System/Path/Internal.hs" #-} (Path.isRelative (Windows.relFile "fred")) DocTest.printPrefix "System.Path.Internal:1437: " {-# LINE 1437 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1437 "src/System/Path/Internal.hs" #-} (forAllAbsRel $ \x -> null (Path.takeExtension x) == not (Path.hasAnExtension x)) DocTest.printPrefix "System.Path.Internal:1443: " {-# LINE 1443 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1443 "src/System/Path/Internal.hs" #-} (Path.hasExtension ".hs" (Posix.relFile "MyCode.hs")) DocTest.printPrefix "System.Path.Internal:1444: " {-# LINE 1444 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1444 "src/System/Path/Internal.hs" #-} (Path.hasExtension ".hs" (Posix.relFile "MyCode.bak.hs")) DocTest.printPrefix "System.Path.Internal:1445: " {-# LINE 1445 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1445 "src/System/Path/Internal.hs" #-} (not $ Path.hasExtension ".hs" (Posix.relFile "MyCode.hs.bak")) DocTest.printPrefix "System.Path.Internal:1455: " {-# LINE 1455 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1455 "src/System/Path/Internal.hs" #-} (Posix.extSeparator == '.') DocTest.printPrefix "System.Path.Internal:1466: " {-# LINE 1466 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1466 "src/System/Path/Internal.hs" #-} (\a -> Posix.isExtSeparator a == (a == Posix.extSeparator)) DocTest.printPrefix "System.Path.Internal:1472: " {-# LINE 1472 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1472 "src/System/Path/Internal.hs" #-} (\a -> Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator)) DocTest.printPrefix "System.Path.Internal:1488: " {-# LINE 1488 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1488 "src/System/Path/Internal.hs" #-} (Path.genericAddExtension (absDir "/") "x" == Posix.absDir "/.x") DocTest.printPrefix "System.Path.Internal:1489: " {-# LINE 1489 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1489 "src/System/Path/Internal.hs" #-} (Path.genericAddExtension (absDir "/a") "x" == Posix.absDir "/a.x") DocTest.printPrefix "System.Path.Internal:1490: " {-# LINE 1490 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1490 "src/System/Path/Internal.hs" #-} (Path.genericAddExtension Path.emptyFile "x" == Posix.relFile ".x") DocTest.printPrefix "System.Path.Internal:1491: " {-# LINE 1491 "src/System/Path/Internal.hs" #-} DocTest.property {-# LINE 1491 "src/System/Path/Internal.hs" #-} (Path.genericAddExtension Path.emptyFile "" == Posix.emptyFile)