From 885974be995cc049c037b76a525e594d02f98d53 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 9 Nov 2020 20:07:31 -0400 Subject: [PATCH] add newtypes for QuickCheck to avoid LANG=C issues All properties changed to use them, except for prop_encode_c_decode_c_roundtrip, which already filtered to ascii for other reasons. A few modules had to be split out, because Setup does not build-depend on QuickCheck. --- Annex.hs | 2 +- Annex/View/ViewedFile.hs | 6 ++- Common.hs | 3 +- Git/Filename.hs | 28 +++++------ Key.hs | 13 ++--- Logs/Remote/Pure.hs | 7 ++- Remote/Rsync/RsyncUrl.hs | 1 + Test.hs | 14 +++--- Utility/Base64.hs | 7 ++- Utility/Path.hs | 36 -------------- Utility/Path/Tests.hs | 58 ++++++++++++++++++++++ Utility/QuickCheck.hs | 41 +++++++++++++++- Utility/SafeCommand.hs | 47 +----------------- Utility/ShellEscape.hs | 65 +++++++++++++++++++++++++ Utility/Verifiable.hs | 9 ++-- doc/bugs/tests_fail_on_Linux_build.mdwn | 2 + git-annex.cabal | 2 + 17 files changed, 211 insertions(+), 130 deletions(-) create mode 100644 Utility/Path/Tests.hs create mode 100644 Utility/ShellEscape.hs diff --git a/Annex.hs b/Annex.hs index ed9433fea0..5ae01ea2ac 100644 --- a/Annex.hs +++ b/Annex.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE GeneralizedNewtypeDeriving, PackageImports, BangPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, BangPatterns #-} module Annex ( Annex, diff --git a/Annex/View/ViewedFile.hs b/Annex/View/ViewedFile.hs index a94ac3c578..fccf9b48ec 100644 --- a/Annex/View/ViewedFile.hs +++ b/Annex/View/ViewedFile.hs @@ -17,6 +17,7 @@ module Annex.View.ViewedFile ( ) where import Annex.Common +import Utility.QuickCheck import qualified Data.ByteString as S @@ -78,11 +79,12 @@ dirFromViewedFile = joinPath . drop 1 . sep [] "" [] -> sep l curr cs | otherwise = sep l (c:curr) cs -prop_viewedFile_roundtrips :: FilePath -> Bool -prop_viewedFile_roundtrips f +prop_viewedFile_roundtrips :: TestableFilePath -> Bool +prop_viewedFile_roundtrips tf -- Relative filenames wanted, not directories. | any (isPathSeparator) (end f ++ beginning f) = True | isAbsolute f = True | otherwise = dir == dirFromViewedFile (viewedFileFromReference f) where + f = fromTestableFilePath tf dir = joinPath $ beginning $ splitDirectories f diff --git a/Common.hs b/Common.hs index 6069614e6e..95029bca99 100644 --- a/Common.hs +++ b/Common.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE PackageImports #-} - module Common (module X) where import Control.Monad as X @@ -21,6 +19,7 @@ import Utility.Misc as X import Utility.Exception as X import Utility.DebugLocks as X import Utility.SafeCommand as X +import Utility.ShellEscape as X import Utility.Process as X import Utility.Path as X import Utility.Path.AbsRel as X diff --git a/Git/Filename.hs b/Git/Filename.hs index 010e5bae9e..2fa4c59ac8 100644 --- a/Git/Filename.hs +++ b/Git/Filename.hs @@ -10,6 +10,7 @@ module Git.Filename where import Common import Utility.Format (decode_c, encode_c) +import Utility.QuickCheck import Data.Char import Data.Word @@ -35,21 +36,14 @@ decode b = case S.uncons b of encode :: RawFilePath -> S.ByteString encode s = encodeBS $ "\"" ++ encode_c (decodeBS s) ++ "\"" -prop_encode_decode_roundtrip :: FilePath -> Bool -prop_encode_decode_roundtrip s = s' == - fromRawFilePath (decode (encode (toRawFilePath s'))) +-- Encoding and then decoding roundtrips only when the string does not +-- contain high unicode, because eg, both "\12345" and "\227\128\185" +-- are encoded to "\343\200\271". +-- +-- That is not a real-world problem, and using TestableFilePath +-- limits what's tested to ascii, so avoids running into it. +prop_encode_decode_roundtrip :: TestableFilePath -> Bool +prop_encode_decode_roundtrip ts = + s == fromRawFilePath (decode (encode (toRawFilePath s))) where - s' = nonul (nohigh s) - -- Encoding and then decoding roundtrips only when - -- the string does not contain high unicode, because eg, - -- both "\12345" and "\227\128\185" are encoded to - -- "\343\200\271". - -- - -- This property papers over the problem, by only - -- testing ascii - nohigh = filter isAscii - -- A String can contain a NUL, but toRawFilePath - -- truncates on the NUL, which is generally fine - -- because unix filenames cannot contain NUL. - -- So the encoding only roundtrips when there is no nul. - nonul = filter (/= '\NUL') + s = fromTestableFilePath ts diff --git a/Key.hs b/Key.hs index 89f168be11..d500b2a1a0 100644 --- a/Key.hs +++ b/Key.hs @@ -31,7 +31,6 @@ module Key ( prop_isomorphic_key_encode ) where -import Data.Char import qualified Data.Text as T import qualified Data.ByteString as S import qualified Data.Attoparsec.ByteString as A @@ -100,16 +99,10 @@ instance Arbitrary KeyData where <*> ((abs <$>) <$> arbitrary) -- chunksize cannot be negative <*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative --- AssociatedFile cannot be empty, and cannot contain a NUL --- (but can be Nothing). instance Arbitrary AssociatedFile where - arbitrary = (AssociatedFile . fmap conv <$> arbitrary) - `suchThat` (/= AssociatedFile (Just S.empty)) - `suchThat` (\(AssociatedFile f) -> maybe True (S.notElem 0) f) - where - -- Generating arbitrary unicode leads to encoding errors - -- when LANG=C, so limit to ascii. - conv = toRawFilePath . filter isAscii + arbitrary = AssociatedFile + . fmap (toRawFilePath . fromTestableFilePath) + <$> arbitrary instance Arbitrary Key where arbitrary = mkKey . const <$> arbitrary diff --git a/Logs/Remote/Pure.hs b/Logs/Remote/Pure.hs index 7d05269be6..07f5ef16d7 100644 --- a/Logs/Remote/Pure.hs +++ b/Logs/Remote/Pure.hs @@ -22,6 +22,7 @@ import Types.Remote import Types.ProposedAccepted import Logs.UUIDBased import Annex.SpecialRemote.Config +import Utility.QuickCheck import qualified Data.ByteString.Lazy as L import qualified Data.Map as M @@ -85,8 +86,10 @@ configUnEscape = unescape rest = drop 1 r {- for quickcheck -} -prop_isomorphic_configEscape :: String -> Bool -prop_isomorphic_configEscape s = s == (configUnEscape . configEscape) s +prop_isomorphic_configEscape :: TestableString -> Bool +prop_isomorphic_configEscape ts = s == (configUnEscape . configEscape) s + where + s = fromTestableString ts prop_parse_show_Config :: RemoteConfig -> Bool prop_parse_show_Config c diff --git a/Remote/Rsync/RsyncUrl.hs b/Remote/Rsync/RsyncUrl.hs index affa924ef9..d0e1714557 100644 --- a/Remote/Rsync/RsyncUrl.hs +++ b/Remote/Rsync/RsyncUrl.hs @@ -13,6 +13,7 @@ import Types import Annex.Locations import Utility.Rsync import Utility.SafeCommand +import Utility.ShellEscape import Utility.FileSystemEncoding import Annex.DirHashes #ifdef mingw32_HOST_OS diff --git a/Test.hs b/Test.hs index 66f504e072..b67dff8398 100644 --- a/Test.hs +++ b/Test.hs @@ -30,7 +30,7 @@ import Control.Concurrent.STM hiding (check) import Common import CmdLine.GitAnnex.Options -import qualified Utility.SafeCommand +import qualified Utility.ShellEscape import qualified Utility.RawFilePath as R import qualified Annex import qualified Git.Filename @@ -69,7 +69,7 @@ import qualified Annex.View import qualified Annex.View.ViewedFile import qualified Logs.View import qualified Command.TestRemote -import qualified Utility.Path +import qualified Utility.Path.Tests import qualified Utility.FileMode import qualified BuildInfo import qualified Utility.Format @@ -184,13 +184,13 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $ [ testProperty "prop_encode_decode_roundtrip" Git.Filename.prop_encode_decode_roundtrip , testProperty "prop_encode_c_decode_c_roundtrip" Utility.Format.prop_encode_c_decode_c_roundtrip , testProperty "prop_isomorphic_key_encode" Key.prop_isomorphic_key_encode - , testProperty "prop_isomorphic_shellEscape" Utility.SafeCommand.prop_isomorphic_shellEscape - , testProperty "prop_isomorphic_shellEscape_multiword" Utility.SafeCommand.prop_isomorphic_shellEscape_multiword + , testProperty "prop_isomorphic_shellEscape" Utility.ShellEscape.prop_isomorphic_shellEscape + , testProperty "prop_isomorphic_shellEscape_multiword" Utility.ShellEscape.prop_isomorphic_shellEscape_multiword , testProperty "prop_isomorphic_configEscape" Logs.Remote.prop_isomorphic_configEscape , testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config - , testProperty "prop_upFrom_basics" Utility.Path.prop_upFrom_basics - , testProperty "prop_relPathDirToFileAbs_basics" Utility.Path.prop_relPathDirToFileAbs_basics - , testProperty "prop_relPathDirToFileAbs_regressionTest" Utility.Path.prop_relPathDirToFileAbs_regressionTest + , testProperty "prop_upFrom_basics" Utility.Path.Tests.prop_upFrom_basics + , testProperty "prop_relPathDirToFileAbs_basics" Utility.Path.Tests.prop_relPathDirToFileAbs_basics + , testProperty "prop_relPathDirToFileAbs_regressionTest" Utility.Path.Tests.prop_relPathDirToFileAbs_regressionTest , testProperty "prop_cost_sane" Config.Cost.prop_cost_sane , testProperty "prop_matcher_sane" Utility.Matcher.prop_matcher_sane , testProperty "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane diff --git a/Utility/Base64.hs b/Utility/Base64.hs index f30d9d62ee..deeaa3d95e 100644 --- a/Utility/Base64.hs +++ b/Utility/Base64.hs @@ -8,6 +8,7 @@ module Utility.Base64 where import Utility.FileSystemEncoding +import Utility.QuickCheck import qualified "sandi" Codec.Binary.Base64 as B64 import Data.Maybe @@ -43,7 +44,9 @@ fromB64' = fromMaybe bad . fromB64Maybe' -- Only ascii strings are tested, because an arbitrary string may contain -- characters not encoded using the FileSystemEncoding, which would thus -- not roundtrip, as decodeBS always generates an output encoded that way. -prop_b64_roundtrips :: String -> Bool -prop_b64_roundtrips s +prop_b64_roundtrips :: TestableString -> Bool +prop_b64_roundtrips ts | all (isAscii) s = s == decodeBS (fromB64' (toB64' (encodeBS s))) | otherwise = True + where + s = fromTestableString ts diff --git a/Utility/Path.hs b/Utility/Path.hs index 1ef147bd5e..b8f44e38bc 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -23,10 +23,6 @@ module Utility.Path ( dotfile, splitShortExtensions, relPathDirToFileAbs, - - prop_upFrom_basics, - prop_relPathDirToFileAbs_basics, - prop_relPathDirToFileAbs_regressionTest, ) where import System.FilePath.ByteString @@ -39,7 +35,6 @@ import Prelude import Utility.Monad import Utility.SystemDirectory -import Utility.FileSystemEncoding {- Simplifies a path, removing any "." component, collapsing "dir/..", - and removing the trailing path separator. @@ -85,15 +80,6 @@ upFrom dir (drive, path) = splitDrive dir dirs = filter (not . B.null) $ B.splitWith isPathSeparator path -prop_upFrom_basics :: FilePath -> Bool -prop_upFrom_basics dir - | null dir = True - | '\NUL' `elem` dir = True -- not a legal filename - | dir == "/" = p == Nothing - | otherwise = p /= Just dir - where - p = fromRawFilePath <$> upFrom (toRawFilePath dir) - {- Checks if the first RawFilePath is, or could be said to contain the second. - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc - are all equivilant. @@ -223,25 +209,3 @@ relPathDirToFileAbs from to #ifdef mingw32_HOST_OS normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive #endif - -prop_relPathDirToFileAbs_basics :: FilePath -> FilePath -> Bool -prop_relPathDirToFileAbs_basics from to - | null from || null to = True - | '\NUL' `elem` from || '\NUL' `elem` to = True -- not a legal filename - | from == to = null r - | otherwise = not (null r) - where - r = fromRawFilePath $ relPathDirToFileAbs - (toRawFilePath from) - (toRawFilePath to) - -prop_relPathDirToFileAbs_regressionTest :: Bool -prop_relPathDirToFileAbs_regressionTest = same_dir_shortcurcuits_at_difference - where - {- Two paths have the same directory component at the same - - location, but it's not really the same directory. - - Code used to get this wrong. -} - same_dir_shortcurcuits_at_difference = - relPathDirToFileAbs (joinPath [pathSeparator `B.cons` "tmp", "r", "lll", "xxx", "yyy", "18"]) - (joinPath [pathSeparator `B.cons` "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]) - == joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"] diff --git a/Utility/Path/Tests.hs b/Utility/Path/Tests.hs new file mode 100644 index 0000000000..ba0330c7f6 --- /dev/null +++ b/Utility/Path/Tests.hs @@ -0,0 +1,58 @@ +{- Tests for Utility.Path. Split into a separate module to avoid it needing + - QuickCheck. + - + - Copyright 2010-2020 Joey Hess + - + - License: BSD-2-clause + -} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.Path.Tests ( + prop_upFrom_basics, + prop_relPathDirToFileAbs_basics, + prop_relPathDirToFileAbs_regressionTest, +) where + +import System.FilePath.ByteString +import qualified Data.ByteString as B +import Data.List +import Data.Maybe +import Control.Applicative +import Prelude + +import Utility.Path +import Utility.FileSystemEncoding +import Utility.QuickCheck + +prop_upFrom_basics :: TestableFilePath -> Bool +prop_upFrom_basics tdir + | dir == "/" = p == Nothing + | otherwise = p /= Just dir + where + p = fromRawFilePath <$> upFrom (toRawFilePath dir) + dir = fromTestableFilePath tdir + +prop_relPathDirToFileAbs_basics :: TestableFilePath -> TestableFilePath -> Bool +prop_relPathDirToFileAbs_basics fromt tot + | from == to = null r + | otherwise = not (null r) + where + from = fromTestableFilePath fromt + to = fromTestableFilePath tot + r = fromRawFilePath $ relPathDirToFileAbs + (toRawFilePath from) + (toRawFilePath to) + +prop_relPathDirToFileAbs_regressionTest :: Bool +prop_relPathDirToFileAbs_regressionTest = same_dir_shortcurcuits_at_difference + where + {- Two paths have the same directory component at the same + - location, but it's not really the same directory. + - Code used to get this wrong. -} + same_dir_shortcurcuits_at_difference = + relPathDirToFileAbs (joinPath [pathSeparator `B.cons` "tmp", "r", "lll", "xxx", "yyy", "18"]) + (joinPath [pathSeparator `B.cons` "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]) + == joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"] diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs index b0a39f3ca4..2093670a06 100644 --- a/Utility/QuickCheck.hs +++ b/Utility/QuickCheck.hs @@ -1,6 +1,6 @@ {- QuickCheck with additional instances - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2020 Joey Hess - - License: BSD-2-clause -} @@ -10,16 +10,53 @@ module Utility.QuickCheck ( module X - , module Utility.QuickCheck + , TestableString + , fromTestableString + , TestableFilePath + , fromTestableFilePath + , nonNegative + , positive ) where import Test.QuickCheck as X import Data.Time.Clock.POSIX import Data.Ratio +import Data.Char import System.Posix.Types import Data.List.NonEmpty (NonEmpty(..)) import Prelude +{- A String, but Arbitrary is limited to ascii. + - + - When in a non-utf8 locale, String does not normally contain any non-ascii + - characters, except for ones in surrogate plane. Converting a string that + - does contain other unicode characters to a ByteString using the + - filesystem encoding (see GHC.IO.Encoding) will throw an exception, + - so use this instead to avoid quickcheck tests breaking unncessarily. + -} +newtype TestableString = TestableString + { fromTestableString :: String } + deriving (Show) + +instance Arbitrary TestableString where + arbitrary = TestableString . filter isAscii <$> arbitrary + +{- FilePath constrained to not be the empty string, not contain a NUL, + - and contain only ascii. + - + - No real-world filename can be empty or contain a NUL. So code can + - well be written that assumes that and using this avoids quickcheck + - tests breaking unncessarily. + -} +newtype TestableFilePath = TestableFilePath + { fromTestableFilePath :: FilePath } + deriving (Show) + +instance Arbitrary TestableFilePath where + arbitrary = (TestableFilePath . fromTestableString <$> arbitrary) + `suchThat` (not . null . fromTestableFilePath) + `suchThat` (not . any (== '\NUL') . fromTestableFilePath) + {- Times before the epoch are excluded. Half with decimal and half without. -} instance Arbitrary POSIXTime where arbitrary = do diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs index 51e151e0f3..6f9419cd8c 100644 --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -16,18 +16,13 @@ module Utility.SafeCommand ( safeSystem, safeSystem', safeSystemEnv, - shellWrap, - shellEscape, - shellUnEscape, segmentXargsOrdered, segmentXargsUnordered, - prop_isomorphic_shellEscape, - prop_isomorphic_shellEscape_multiword, ) where -import System.Exit import Utility.Process -import Utility.Split + +import System.Exit import System.FilePath import Data.Char import Data.List @@ -93,44 +88,6 @@ safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Ex safeSystemEnv command params environ = safeSystem' command params $ \p -> p { env = environ } --- | Wraps a shell command line inside sh -c, allowing it to be run in a --- login shell that may not support POSIX shell, eg csh. -shellWrap :: String -> String -shellWrap cmdline = "sh -c " ++ shellEscape cmdline - --- | Escapes a filename or other parameter to be safely able to be exposed to --- the shell. --- --- This method works for POSIX shells, as well as other shells like csh. -shellEscape :: String -> String -shellEscape f = "'" ++ escaped ++ "'" - where - -- replace ' with '"'"' - escaped = intercalate "'\"'\"'" $ splitc '\'' f - --- | Unescapes a set of shellEscaped words or filenames. -shellUnEscape :: String -> [String] -shellUnEscape [] = [] -shellUnEscape s = word : shellUnEscape rest - where - (word, rest) = findword "" s - findword w [] = (w, "") - findword w (c:cs) - | c == ' ' = (w, cs) - | c == '\'' = inquote c w cs - | c == '"' = inquote c w cs - | otherwise = findword (w++[c]) cs - inquote _ w [] = (w, "") - inquote q w (c:cs) - | c == q = findword w cs - | otherwise = inquote q (w++[c]) cs - --- | For quickcheck. -prop_isomorphic_shellEscape :: String -> Bool -prop_isomorphic_shellEscape s = [s] == (shellUnEscape . shellEscape) s -prop_isomorphic_shellEscape_multiword :: [String] -> Bool -prop_isomorphic_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s - -- | Segments a list of filenames into groups that are all below the maximum -- command-line length limit. segmentXargsOrdered :: [FilePath] -> [[FilePath]] diff --git a/Utility/ShellEscape.hs b/Utility/ShellEscape.hs new file mode 100644 index 0000000000..9bd229a4c1 --- /dev/null +++ b/Utility/ShellEscape.hs @@ -0,0 +1,65 @@ +{- shell escaping + - + - Copyright 2010-2015 Joey Hess + - + - License: BSD-2-clause + -} + +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.ShellEscape ( + shellWrap, + shellEscape, + shellUnEscape, + prop_isomorphic_shellEscape, + prop_isomorphic_shellEscape_multiword, +) where + +import Utility.QuickCheck +import Utility.Split + +import Data.List +import Prelude + +-- | Wraps a shell command line inside sh -c, allowing it to be run in a +-- login shell that may not support POSIX shell, eg csh. +shellWrap :: String -> String +shellWrap cmdline = "sh -c " ++ shellEscape cmdline + +-- | Escapes a filename or other parameter to be safely able to be exposed to +-- the shell. +-- +-- This method works for POSIX shells, as well as other shells like csh. +shellEscape :: String -> String +shellEscape f = "'" ++ escaped ++ "'" + where + -- replace ' with '"'"' + escaped = intercalate "'\"'\"'" $ splitc '\'' f + +-- | Unescapes a set of shellEscaped words or filenames. +shellUnEscape :: String -> [String] +shellUnEscape [] = [] +shellUnEscape s = word : shellUnEscape rest + where + (word, rest) = findword "" s + findword w [] = (w, "") + findword w (c:cs) + | c == ' ' = (w, cs) + | c == '\'' = inquote c w cs + | c == '"' = inquote c w cs + | otherwise = findword (w++[c]) cs + inquote _ w [] = (w, "") + inquote q w (c:cs) + | c == q = findword w cs + | otherwise = inquote q (w++[c]) cs + +prop_isomorphic_shellEscape :: TestableString -> Bool +prop_isomorphic_shellEscape ts = [s] == (shellUnEscape . shellEscape) s + where + s = fromTestableString ts + +prop_isomorphic_shellEscape_multiword :: [TestableString] -> Bool +prop_isomorphic_shellEscape_multiword ts = + l == (shellUnEscape . unwords . map shellEscape) l + where + l = map fromTestableString ts diff --git a/Utility/Verifiable.hs b/Utility/Verifiable.hs index e24cd446d9..a437d947f6 100644 --- a/Utility/Verifiable.hs +++ b/Utility/Verifiable.hs @@ -18,6 +18,7 @@ import Data.ByteString.UTF8 (fromString) import qualified Data.ByteString as S import Utility.Hash +import Utility.QuickCheck type Secret = S.ByteString type HMACDigest = String @@ -38,8 +39,8 @@ verify v secret = v == mkVerifiable (verifiableVal v) secret calcDigest :: String -> Secret -> HMACDigest calcDigest v secret = calcMac HmacSha1 secret (fromString v) -{- for quickcheck -} -prop_verifiable_sane :: String -> String -> Bool -prop_verifiable_sane a s = verify (mkVerifiable a secret) secret +prop_verifiable_sane :: TestableString -> TestableString -> Bool +prop_verifiable_sane v ts = + verify (mkVerifiable (fromTestableString v) secret) secret where - secret = fromString s + secret = fromString (fromTestableString ts) diff --git a/doc/bugs/tests_fail_on_Linux_build.mdwn b/doc/bugs/tests_fail_on_Linux_build.mdwn index 89c3831694..664939b8e9 100644 --- a/doc/bugs/tests_fail_on_Linux_build.mdwn +++ b/doc/bugs/tests_fail_on_Linux_build.mdwn @@ -23,3 +23,5 @@ OSX and Windows [still FTBFS differently](https://github.com/datalad/git-annex/p [[!meta author=yoh]] [[!tag projects/datalad]] + +[[!fixed|done]] --[[Joey]] diff --git a/git-annex.cabal b/git-annex.cabal index 3ed8619145..fd9a492e4d 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1099,6 +1099,7 @@ Executable git-annex Utility.Path Utility.Path.AbsRel Utility.Path.Max + Utility.Path.Tests Utility.Percentage Utility.Process Utility.Process.Shim @@ -1111,6 +1112,7 @@ Executable git-annex Utility.Scheduled Utility.Scheduled.QuickCheck Utility.Shell + Utility.ShellEscape Utility.SimpleProtocol Utility.Split Utility.SshConfig