Fix test suite failure on Windows

It would be better if the Arbitrary instance avoided generating impossible
filenames like "foo/c:bar", but proably this is the only place that splits
the file from the directory and then uses the file without the directory..
At least on the quickcheck properties.

Sponsored-by: Svenne Krap on Patreon

Annex/View/ViewedFile.hs

@@ -36,7 +36,7 @@ type MkViewedFile = FilePath -> ViewedFile
  - So, from dir/subdir/file.foo, generate file_%dir%subdir%.foo
  -}
 viewedFileFromReference :: MkViewedFile
-viewedFileFromReference f = concat
+viewedFileFromReference f = concat $
 	[ escape (fromRawFilePath base)
 	, if null dirs then "" else "_%" ++ intercalate "%" (map escape dirs) ++ "%"
 	, escape $ fromRawFilePath $ S.concat extensions
@@ -44,7 +44,13 @@ viewedFileFromReference f = concat
   where
 	(path, basefile) = splitFileName f
 	dirs = filter (/= ".") $ map dropTrailingPathSeparator (splitPath path)
-	(base, extensions) = splitShortExtensions (toRawFilePath basefile)
+	(base, extensions) = splitShortExtensions (toRawFilePath basefile')
+	
+	{- On Windows, if the filename looked like "dir/c:foo" then
+	 - basefile would look like it contains a drive letter, which will
+	 - not work. There cannot really be a filename like that, probably,
+	 - but it prevents the test suite failing. -}
+	(_basedrive, basefile') = splitDrive basefile
 
 	{- To avoid collisions with filenames or directories that contain
 	 - '%', and to allow the original directories to be extracted

CHANGELOG

@@ -14,6 +14,7 @@ git-annex (8.20210804) UNRELEASED; urgency=medium
     on other OS's (except for adb, external, gcrypt, hook, and rsync).
   * unused: Skip the refs/annex/last-index ref that git-annex recently
     started creating.
+  * Fix test suite failure on Windows.
 
  -- Joey Hess <id@joeyh.name>  Tue, 03 Aug 2021 12:22:45 -0400
 

doc/bugs/test_prop__95__view__95__roundtrips_fails_occasionally.mdwn

@@ -96,3 +96,5 @@ Windows version 21H1 (build 19043.1165), 64 bit.
 ### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)
 
 Git Annex is great. It works with multi-gigabyte backup files (largest around 180GB) via the BLAKE2B160E backend just dandy :)
+
+> [[fixed|done]] --[[Joey]]

doc/bugs/test_prop__95__view__95__roundtrips_fails_occasionally/comment_1_1cac754c9fc86da7a7cb11db0c776190._comment

@@ -0,0 +1,27 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2021-08-24T17:01:01Z"
+ content="""
+I fixed the other, similar bug shortly after you filed it. Please do file
+bug reports for intermittent test suite breakage like this.
+
+This does not reproduce on linux with --quickcheck-replay=258328, it's
+windows specific. I can reproduce it by subbing in the windows filepath
+modules on linux.
+
+Simplified:
+
+	ghci> let f = AssociatedFile (Just "foo\\X:l")
+	ghci> let m = MetaData (fromList [(MetaField "H",S.fromList [MetaValue (CurrentlySet True) ">"]),(MetaField "HJ",S.fromList [MetaValue (CurrentlySet True) "a"]),(MetaField "m",S.fromList [MetaValue (CurrentlySet True) "#"]),(MetaField "ub",S.fromList [MetaValue (CurrentlySet True) "9"])])
+	ghci> prop_view_roundtrips f m True
+	False
+
+Looks like viewedFileFromReference of that filename produces "X:l_%\\\\%",
+which won't work because that looks like a drive letter.
+
+This can't occur in real life, because "X:l" can't be the name of a file
+in a directory "foo".
+
+Fixed.
+"""]]