diff --git a/Git/Filename.hs b/Git/Filename.hs index ee84d48832..355e75f459 100644 --- a/Git/Filename.hs +++ b/Git/Filename.hs @@ -8,9 +8,10 @@ module Git.Filename where +import Common import Utility.Format (decode_c, encode_c) -import Common +import Data.Char decode :: String -> FilePath decode [] = [] @@ -23,6 +24,11 @@ decode f@(c:s) encode :: FilePath -> String encode s = "\"" ++ encode_c s ++ "\"" -{- for quickcheck -} -prop_isomorphic_deencode :: String -> Bool -prop_isomorphic_deencode s = s == decode (encode s) +{- For quickcheck. + - + - See comment on Utility.Format.prop_encode_c_decode_c_roundtrip for + - why this only tests chars < 256 -} +prop_encode_decode_roundtrip :: String -> Bool +prop_encode_decode_roundtrip s = s' == decode (encode s') + where + s' = filter (\c -> ord c < 256) s diff --git a/Test.hs b/Test.hs index ec765182e4..8c56b0986e 100644 --- a/Test.hs +++ b/Test.hs @@ -161,8 +161,8 @@ tests crippledfilesystem opts = testGroup "Tests" $ properties : properties :: TestTree properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" - [ testProperty "prop_isomorphic_deencode_git" Git.Filename.prop_isomorphic_deencode - , testProperty "prop_isomorphic_deencode" Utility.Format.prop_isomorphic_deencode + [ 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_fileKey" Annex.Locations.prop_isomorphic_fileKey , testProperty "prop_isomorphic_key_encode" Key.prop_isomorphic_key_encode , testProperty "prop_isomorphic_key_decode" Key.prop_isomorphic_key_decode diff --git a/Utility/Format.hs b/Utility/Format.hs index 1ebf68d6cf..3670cd717a 100644 --- a/Utility/Format.hs +++ b/Utility/Format.hs @@ -11,7 +11,7 @@ module Utility.Format ( format, decode_c, encode_c, - prop_isomorphic_deencode + prop_encode_c_decode_c_roundtrip ) where import Text.Printf (printf) @@ -100,8 +100,8 @@ empty :: Frag -> Bool empty (Const "") = True empty _ = False -{- Decodes a C-style encoding, where \n is a newline, \NNN is an octal - - encoded character, and \xNN is a hex encoded character. +{- Decodes a C-style encoding, where \n is a newline (etc), + - \NNN is an octal encoded character, and \xNN is a hex encoded character. -} decode_c :: FormatString -> String decode_c [] = [] @@ -173,6 +173,15 @@ encode_c' p = concatMap echar e_asc c = showoctal $ ord c showoctal i = '\\' : printf "%03o" i -{- for quickcheck -} -prop_isomorphic_deencode :: String -> Bool -prop_isomorphic_deencode s = s == decode_c (encode_c s) +{- For quickcheck. + - + - 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 chars < 256. + -} +prop_encode_c_decode_c_roundtrip :: String -> Bool +prop_encode_c_decode_c_roundtrip s = s' == decode_c (encode_c s') + where + s' = filter (\c -> ord c < 256) s diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index dae254854b..94d588cd7e 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -184,6 +184,9 @@ secretKeys cmd = catchDefaultIO M.empty makemap params = [Param "--with-colons", Param "--list-secret-keys", Param "--fixed-list-mode"] parse = extract [] Nothing . map (splitc ':') extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) = + -- If the userid contains a ":" or a few other special + -- characters, gpg will hex-escape it. Use decode_c to + -- undo. extract ((keyid, decode_c userid):c) Nothing rest extract c (Just keyid) rest@(("sec":_):_) = extract ((keyid, ""):c) Nothing rest