1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937
|
{- git-annex test suite
-
- Copyright 2010-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Test where
import Types.Test
import Types.RepoVersion
import Test.Framework
import Options.Applicative.Types
import Test.Tasty
import Test.Tasty.Runners
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Test.Tasty.Ingredients.Rerun
import Test.Tasty.Options
import Options.Applicative (switch, long, help, internal)
import qualified Data.Map as M
import qualified Data.ByteString.Lazy.UTF8 as BU8
import System.Environment
import Control.Concurrent.STM hiding (check)
import Common
import CmdLine.GitAnnex.Options
import qualified Utility.ShellEscape
import qualified Utility.RawFilePath as R
import qualified Annex
import qualified Git.Filename
import qualified Git.Types
import qualified Git.Ref
import qualified Git.LsTree
import qualified Git.FilePath
import qualified Annex.Locations
#ifndef mingw32_HOST_OS
import qualified Types.GitConfig
#endif
import qualified Types.TrustLevel
import qualified Types
import qualified Logs.MapLog
import qualified Logs.Trust
import qualified Logs.Remote
import qualified Logs.Unused
import qualified Logs.Transfer
import qualified Logs.Presence
import qualified Logs.ContentIdentifier
import qualified Logs.PreferredContent
import qualified Types.MetaData
import qualified Remote
import qualified Key
import qualified Config
import qualified Config.Cost
import qualified Crypto
import qualified Database.Keys
import qualified Annex.WorkTree
import qualified Annex.Init
import qualified Annex.CatFile
import qualified Annex.Path
import qualified Annex.VectorClock
import qualified Annex.AdjustedBranch
import qualified Annex.View
import qualified Annex.View.ViewedFile
import qualified Logs.View
import qualified Command.TestRemote
import qualified Utility.Path.Tests
import qualified Utility.FileMode
import qualified BuildInfo
import qualified Utility.Format
import qualified Utility.Verifiable
import qualified Utility.Process
import qualified Utility.Misc
import qualified Utility.InodeCache
import qualified Utility.Env
import qualified Utility.Env.Set
import qualified Utility.Matcher
import qualified Utility.Hash
import qualified Utility.Scheduled
import qualified Utility.Scheduled.QuickCheck
import qualified Utility.HumanTime
import qualified Utility.Base64
import qualified Utility.Tmp.Dir
import qualified Utility.FileSystemEncoding
import qualified Utility.Aeson
import qualified Utility.CopyFile
import qualified Types.Remote
#ifndef mingw32_HOST_OS
import qualified Remote.Helper.Encryptable
import qualified Types.Crypto
import qualified Utility.Gpg
#endif
optParser :: Parser TestOptions
optParser = TestOptions
<$> snd tastyParser
<*> switch
( long "keep-failures"
<> help "preserve repositories on test failure"
)
<*> switch
( long "fakessh"
<> internal
)
<*> cmdParams "non-options are for internal use only"
tastyParser :: ([String], Parser Test.Tasty.Options.OptionSet)
#if MIN_VERSION_tasty(1,3,0)
tastyParser = go
#else
tastyParser = ([], go)
#endif
where
go = suiteOptionParser ingredients (tests False True mempty)
runner :: TestOptions -> IO ()
runner opts
| fakeSsh opts = runFakeSsh (internalData opts)
| otherwise = runsubprocesstests =<< Utility.Env.getEnv subenv
where
-- Run git-annex test in a subprocess, so that any files
-- it may open will be closed before running finalCleanup.
-- This should prevent most failures to clean up after the test
-- suite.
subenv = "GIT_ANNEX_TEST_SUBPROCESS"
runsubprocesstests Nothing = do
let warnings = fst tastyParser
unless (null warnings) $ do
hPutStrLn stderr "warnings from tasty:"
mapM_ (hPutStrLn stderr) warnings
pp <- Annex.Path.programPath
Utility.Env.Set.setEnv subenv "1" True
ps <- getArgs
exitcode <- withCreateProcess (proc pp ps) $
\_ _ _ pid -> waitForProcess pid
unless (keepFailuresOption opts) finalCleanup
exitWith exitcode
runsubprocesstests (Just _) = isolateGitConfig $ do
ensuretmpdir
crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem' (toRawFilePath tmpdir)
adjustedbranchok <- Annex.AdjustedBranch.isGitVersionSupported
case tryIngredients ingredients (tastyOptionSet opts) (tests crippledfilesystem adjustedbranchok opts) of
Nothing -> error "No tests found!?"
Just act -> ifM act
( exitSuccess
, do
putStrLn " (Failures above could be due to a bug in git-annex, or an incompatibility"
putStrLn " with utilities, such as git, installed on this system.)"
exitFailure
)
ingredients :: [Ingredient]
ingredients =
[ listingTests
, rerunningTests [consoleTestReporter]
]
tests :: Bool -> Bool -> TestOptions -> TestTree
tests crippledfilesystem adjustedbranchok opts =
testGroup "Tests" $ properties
: withTestMode remotetestmode Nothing testRemotes
: map (\(d, te) -> withTestMode te (Just initTests) (unitTests d)) testmodes
where
testmodes = catMaybes
[ canadjust ("v8 adjusted unlocked branch", (testMode opts (RepoVersion 8)) { adjustedUnlockedBranch = True })
, unlesscrippled ("v8 unlocked", (testMode opts (RepoVersion 8)) { unlockedFiles = True })
, unlesscrippled ("v8 locked", testMode opts (RepoVersion 8))
]
remotetestmode = testMode opts (RepoVersion 8)
unlesscrippled v
| crippledfilesystem = Nothing
| otherwise = Just v
canadjust v
| adjustedbranchok = Just v
| otherwise = Nothing
properties :: TestTree
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.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.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
, testProperty "prop_VectorClock_sane" Annex.VectorClock.prop_VectorClock_sane
, testProperty "prop_addMapLog_sane" Logs.MapLog.prop_addMapLog_sane
, testProperty "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
, testProperty "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
, testProperty "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo
, testProperty "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache
, testProperty "prop_parse_build_presence_log" Logs.Presence.prop_parse_build_presence_log
, testProperty "prop_parse_build_contentidentifier_log" Logs.ContentIdentifier.prop_parse_build_contentidentifier_log
, testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
, testProperty "prop_parse_build_TrustLevelLog" Logs.Trust.prop_parse_build_TrustLevelLog
, testProperty "prop_schedule_roundtrips" Utility.Scheduled.QuickCheck.prop_schedule_roundtrips
, testProperty "prop_past_sane" Utility.Scheduled.prop_past_sane
, testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
, testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane
, testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize
, testProperty "prop_branchView_legal" Logs.View.prop_branchView_legal
, testProperty "prop_viewPath_roundtrips" Annex.View.prop_viewPath_roundtrips
, testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips
, testProperty "prop_viewedFile_rountrips" Annex.View.ViewedFile.prop_viewedFile_roundtrips
, testProperty "prop_b64_roundtrips" Utility.Base64.prop_b64_roundtrips
, testProperty "prop_standardGroups_parse" Logs.PreferredContent.prop_standardGroups_parse
] ++ map (uncurry testProperty) combos
where
combos = concat
[ Utility.Hash.props_hashes_stable
, Utility.Hash.props_macs_stable
]
testRemotes :: TestTree
testRemotes = testGroup "Remote Tests"
[ testGitRemote
, testDirectoryRemote
]
testGitRemote :: TestTree
testGitRemote = testRemote False "git" $ \remotename -> do
git "clone" [".", "remotedir"] "git clone"
git "remote" ["add", remotename, "remotedir"] "git remote add"
testDirectoryRemote :: TestTree
testDirectoryRemote = testRemote True "directory" $ \remotename -> do
createDirectory "remotedir"
git_annex "initremote"
[ remotename
, "type=directory"
, "--quiet"
, "directory=remotedir"
, "encryption=none"
] "init"
testRemote :: Bool -> String -> (String -> IO ()) -> TestTree
testRemote testvariants remotetype setupremote =
withResource newEmptyTMVarIO (const noop) $ \getv ->
testGroup ("testremote type " ++ remotetype) $ concat
[ [testCase "init" (prep getv)]
, go getv
]
where
reponame = "test repo"
remotename = "testremote"
basesz = 1024 * 1024
keysizes = Command.TestRemote.keySizes basesz False
prep getv = do
d <- newmainrepodir
setmainrepodir d
innewrepo $ do
git_annex "init" [reponame, "--quiet"] "init"
setupremote remotename
r <- annexeval $ either error return
=<< Remote.byName' remotename
cache <- Command.TestRemote.newRemoteVariantCache
unavailr <- annexeval $ Types.Remote.mkUnavailable r
exportr <- annexeval $ Command.TestRemote.exportTreeVariant cache r
ks <- annexeval $ mapM Command.TestRemote.randKey keysizes
v <- getv
cv <- annexeval cache
liftIO $ atomically $ putTMVar v
(r, (unavailr, (exportr, (ks, cv))))
go getv = Command.TestRemote.mkTestTrees runannex mkrs mkunavailr mkexportr mkks
where
runannex = inmainrepo . annexeval
mkrs = if testvariants
then Command.TestRemote.remoteVariants cache mkr basesz False
else [fmap (fmap Just) mkr]
mkr = descas (remotetype ++ " remote") (fst <$> v)
mkunavailr = fst . snd <$> v
mkexportr = fst . snd . snd <$> v
mkks = map (\(sz, n) -> desckeysize sz (getk n))
(zip keysizes [0..])
getk n = fmap (!! n) (fst . snd . snd . snd <$> v)
cache = snd . snd . snd . snd <$> v
v = liftIO $ atomically . readTMVar =<< getv
descas = Command.TestRemote.Described
desckeysize sz = descas ("key size " ++ show sz)
{- These tests set up the test environment, but also test some basic parts
- of git-annex. They are always run before the unitTests. -}
initTests :: TestTree
initTests = testGroup "Init Tests"
[ testCase "init" test_init
, testCase "add" test_add
]
unitTests :: String -> TestTree
unitTests note = testGroup ("Unit Tests " ++ note)
[ testCase "add dup" test_add_dup
, testCase "add extras" test_add_extras
, testCase "ignore deleted files" test_ignore_deleted_files
, testCase "metadata" test_metadata
, testCase "export_import" test_export_import
, testCase "export_import_subdir" test_export_import_subdir
, testCase "shared clone" test_shared_clone
, testCase "log" test_log
, testCase "view" test_view
, testCase "magic" test_magic
, testCase "import" test_import
, testCase "reinject" test_reinject
, testCase "unannex (no copy)" test_unannex_nocopy
, testCase "unannex (with copy)" test_unannex_withcopy
, testCase "drop (no remote)" test_drop_noremote
, testCase "drop (with remote)" test_drop_withremote
, testCase "drop (untrusted remote)" test_drop_untrustedremote
, testCase "get" test_get
, testCase "get (ssh remote)" test_get_ssh_remote
, testCase "move" test_move
, testCase "move (ssh remote)" test_move_ssh_remote
, testCase "move (numcopies)" test_move_numcopies
, testCase "copy" test_copy
, testCase "lock" test_lock
, testCase "lock --force" test_lock_force
, testCase "edit (no pre-commit)" test_edit
, testCase "edit (pre-commit)" test_edit_precommit
, testCase "partial commit" test_partial_commit
, testCase "fix" test_fix
, testCase "trust" test_trust
, testCase "fsck (basics)" test_fsck_basic
, testCase "fsck (bare)" test_fsck_bare
, testCase "fsck (local untrusted)" test_fsck_localuntrusted
, testCase "fsck (remote untrusted)" test_fsck_remoteuntrusted
, testCase "fsck --from remote" test_fsck_fromremote
, testCase "migrate" test_migrate
, testCase "migrate (via gitattributes)" test_migrate_via_gitattributes
, testCase "unused" test_unused
, testCase "describe" test_describe
, testCase "find" test_find
, testCase "merge" test_merge
, testCase "info" test_info
, testCase "version" test_version
, testCase "sync" test_sync
, testCase "concurrent get of dup key regression" test_concurrent_get_of_dup_key_regression
, testCase "union merge regression" test_union_merge_regression
, testCase "adjusted branch merge regression" test_adjusted_branch_merge_regression
, testCase "adjusted branch subtree regression" test_adjusted_branch_subtree_regression
, testCase "conflict resolution" test_conflict_resolution
, testCase "conflict resolution (adjusted branch)" test_conflict_resolution_adjusted_branch
, testCase "conflict resolution movein regression" test_conflict_resolution_movein_regression
, testCase "conflict resolution (mixed directory and file)" test_mixed_conflict_resolution
, testCase "conflict resolution symlink bit" test_conflict_resolution_symlink_bit
, testCase "conflict resolution (uncommitted local file)" test_uncommitted_conflict_resolution
, testCase "conflict resolution (removed file)" test_remove_conflict_resolution
, testCase "conflict resolution (nonannexed file)" test_nonannexed_file_conflict_resolution
, testCase "conflict resolution (nonannexed symlink)" test_nonannexed_symlink_conflict_resolution
, testCase "conflict resolution (mixed locked and unlocked file)" test_mixed_lock_conflict_resolution
, testCase "map" test_map
, testCase "uninit" test_uninit
, testCase "uninit (in git-annex branch)" test_uninit_inbranch
, testCase "upgrade" test_upgrade
, testCase "whereis" test_whereis
, testCase "hook remote" test_hook_remote
, testCase "directory remote" test_directory_remote
, testCase "rsync remote" test_rsync_remote
, testCase "bup remote" test_bup_remote
, testCase "crypto" test_crypto
, testCase "preferred content" test_preferred_content
, testCase "add subdirs" test_add_subdirs
, testCase "addurl" test_addurl
]
-- this test case creates the main repo
test_init :: Assertion
test_init = innewrepo $ do
ver <- annexVersion <$> getTestMode
git_annex "init" [reponame, "--version", show (fromRepoVersion ver)] "init"
setupTestMode
where
reponame = "test repo"
-- this test case runs in the main repo, to set up a basic
-- annexed file that later tests will use
test_add :: Assertion
test_add = inmainrepo $ do
writecontent annexedfile $ content annexedfile
add_annex annexedfile "add"
annexed_present annexedfile
writecontent sha1annexedfile $ content sha1annexedfile
git_annex "add" [sha1annexedfile, "--backend=SHA1"] "add with SHA1"
whenM (unlockedFiles <$> getTestMode) $
git_annex "unlock" [sha1annexedfile] "unlock"
annexed_present sha1annexedfile
checkbackend sha1annexedfile backendSHA1
writecontent ingitfile $ content ingitfile
git "add" [ingitfile] "git add"
git "commit" ["-q", "-m", "commit"] "git commit"
git_annex "add" [ingitfile] "add ingitfile should be no-op"
unannexed ingitfile
test_add_dup :: Assertion
test_add_dup = intmpclonerepo $ do
writecontent annexedfiledup $ content annexedfiledup
add_annex annexedfiledup "add of second file with same content failed"
annexed_present annexedfiledup
annexed_present annexedfile
test_add_extras :: Assertion
test_add_extras = intmpclonerepo $ do
writecontent wormannexedfile $ content wormannexedfile
git_annex "add" [wormannexedfile, "--backend=WORM"] "add with WORM"
whenM (unlockedFiles <$> getTestMode) $
git_annex "unlock" [wormannexedfile] "unlock"
annexed_present wormannexedfile
checkbackend wormannexedfile backendWORM
test_ignore_deleted_files :: Assertion
test_ignore_deleted_files = intmpclonerepo $ do
git_annex "get" [annexedfile] "get"
git_annex_expectoutput "find" [] [annexedfile]
removeWhenExistsWith R.removeLink (toRawFilePath annexedfile)
-- A file that has been deleted, but the deletion not staged,
-- is a special case; make sure git-annex skips these.
git_annex_expectoutput "find" [] []
test_metadata :: Assertion
test_metadata = intmpclonerepo $ do
git_annex "metadata" ["-s", "foo=bar", annexedfile] "set metadata"
git_annex_expectoutput "find" ["--metadata", "foo=bar"] [annexedfile]
git_annex_expectoutput "find" ["--metadata", "foo=other"] []
writecontent annexedfiledup $ content annexedfiledup
add_annex annexedfiledup "add of second file with same content failed"
annexed_present annexedfiledup
git_annex_expectoutput "find" ["--metadata", "foo=bar"]
[annexedfile, annexedfiledup]
git_annex_shouldfail "metadata" ["--remove", "foo", "."]
"removing metadata from dir with multiple files not allowed"
git_annex "metadata" ["--remove", "foo", annexedfile]
"removing metadata"
git_annex_expectoutput "find" ["--metadata", "foo=bar"] []
git_annex "metadata" ["--force", "-s", "foo=bar", "."]
"recursively set metadata force"
test_shared_clone :: Assertion
test_shared_clone = intmpsharedclonerepo $ do
v <- catchMaybeIO $ Utility.Process.readProcess "git"
[ "config"
, "--bool"
, "--get"
, "annex.hardlink"
]
v == Just "true\n"
@? "shared clone of repo did not get annex.hardlink set"
test_log :: Assertion
test_log = intmpclonerepo $ do
git_annex "log" [annexedfile] "log"
test_view :: Assertion
test_view = intmpclonerepo $ do
git_annex "metadata" ["-s", "test=test1", annexedfile] "metadata"
git_annex "metadata" ["-s", "test=test2", sha1annexedfile] "metadata"
git_annex "view" ["test=test1"] "entering view"
checkexists annexedfile
checkdoesnotexist sha1annexedfile
test_magic :: Assertion
test_magic = intmpclonerepo $ do
#ifdef WITH_MAGICMIME
git "config" ["annex.largefiles", "mimeencoding=binary"]
"git config annex.largefiles"
writeFile "binary" "\127"
writeFile "text" "test\n"
git_annex "add" ["binary", "text"]
"git-annex add with mimeencoding in largefiles"
git_annex "sync" []
"git-annex sync"
(isJust <$> annexeval (Annex.CatFile.catKeyFile (encodeBS "binary")))
@? "binary file not added to annex despite mimeencoding config"
(isNothing <$> annexeval (Annex.CatFile.catKeyFile (encodeBS "text")))
@? "non-binary file got added to annex despite mimeencoding config"
#else
return ()
#endif
test_import :: Assertion
test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir "importtest" $ \importdir -> do
(toimport1, importf1, imported1) <- mktoimport importdir "import1"
git_annex "import" [toimport1] "import"
annexed_present_imported imported1
checkdoesnotexist importf1
(toimport2, importf2, imported2) <- mktoimport importdir "import2"
git_annex "import" [toimport2] "import of duplicate"
annexed_present_imported imported2
checkdoesnotexist importf2
(toimport3, importf3, imported3) <- mktoimport importdir "import3"
git_annex "import" ["--skip-duplicates", toimport3]
"import of duplicate with --skip-duplicates"
checkdoesnotexist imported3
checkexists importf3
git_annex "import" ["--clean-duplicates", toimport3]
"import of duplicate with --clean-duplicates"
checkdoesnotexist imported3
checkdoesnotexist importf3
(toimport4, importf4, imported4) <- mktoimport importdir "import4"
git_annex "import" ["--deduplicate", toimport4] "import --deduplicate"
checkdoesnotexist imported4
checkdoesnotexist importf4
(toimport5, importf5, imported5) <- mktoimport importdir "import5"
git_annex "import" ["--duplicate", toimport5] "import --duplicate"
annexed_present_imported imported5
checkexists importf5
git_annex "drop" ["--force", imported1, imported2, imported5] "drop"
annexed_notpresent_imported imported2
(toimportdup, importfdup, importeddup) <- mktoimport importdir "importdup"
git_annex_shouldfail "import" ["--clean-duplicates", toimportdup]
"import of missing duplicate with --clean-duplicates not allowed"
checkdoesnotexist importeddup
checkexists importfdup
where
mktoimport importdir subdir = do
createDirectory (importdir </> subdir)
let importf = subdir </> "f"
writecontent (importdir </> importf) (content importf)
return (importdir </> subdir, importdir </> importf, importf)
test_reinject :: Assertion
test_reinject = intmpclonerepo $ do
git_annex "drop" ["--force", sha1annexedfile] "drop"
annexed_notpresent sha1annexedfile
writecontent tmp $ content sha1annexedfile
key <- Key.serializeKey <$> getKey backendSHA1 tmp
git_annex "reinject" [tmp, sha1annexedfile] "reinject"
annexed_present sha1annexedfile
-- fromkey can't be used on a crippled filesystem, since it makes a
-- symlink
unlessM (annexeval Config.crippledFileSystem) $ do
git_annex "fromkey" [key, sha1annexedfiledup] "fromkey for dup"
annexed_present_locked sha1annexedfiledup
where
tmp = "tmpfile"
test_unannex_nocopy :: Assertion
test_unannex_nocopy = intmpclonerepo $ do
annexed_notpresent annexedfile
git_annex "unannex" [annexedfile] "unannex with no copy"
annexed_notpresent annexedfile
test_unannex_withcopy :: Assertion
test_unannex_withcopy = intmpclonerepo $ do
git_annex "get" [annexedfile] "get"
annexed_present annexedfile
git_annex "unannex" [annexedfile, sha1annexedfile] "unannex"
unannexed annexedfile
git_annex "unannex" [annexedfile] "unannex on non-annexed file"
unannexed annexedfile
git_annex "unannex" [ingitfile] "unannex ingitfile should be no-op"
unannexed ingitfile
test_drop_noremote :: Assertion
test_drop_noremote = intmpclonerepo $ do
git_annex "get" [annexedfile] "get"
git "remote" ["rm", "origin"] "git remote rm origin"
git_annex_shouldfail "drop" [annexedfile] "drop with no known copy of file not allowed"
annexed_present annexedfile
git_annex "drop" ["--force", annexedfile] "drop --force"
annexed_notpresent annexedfile
git_annex "drop" [annexedfile] "drop of dropped file"
git_annex "drop" [ingitfile] "drop ingitfile should be no-op"
unannexed ingitfile
test_drop_withremote :: Assertion
test_drop_withremote = intmpclonerepo $ do
git_annex "get" [annexedfile] "get"
annexed_present annexedfile
git_annex "numcopies" ["2"] "numcopies config"
git_annex_shouldfail "drop" [annexedfile] "drop with numcopies not satisfied is not allowed"
git_annex "numcopies" ["1"] "numcopies config"
git_annex "drop" [annexedfile] "drop when origin has copy"
annexed_notpresent annexedfile
-- make sure that the correct symlink is staged for the file
-- after drop
git_annex_expectoutput "status" [] []
inmainrepo $ annexed_present annexedfile
test_drop_untrustedremote :: Assertion
test_drop_untrustedremote = intmpclonerepo $ do
git_annex "untrust" ["origin"] "untrust of origin"
git_annex "get" [annexedfile] "get"
annexed_present annexedfile
git_annex_shouldfail "drop" [annexedfile] "drop with only an untrusted copy of the file should fail"
annexed_present annexedfile
inmainrepo $ annexed_present annexedfile
test_get :: Assertion
test_get = test_get' intmpclonerepo
test_get_ssh_remote :: Assertion
test_get_ssh_remote =
#ifndef mingw32_HOST_OS
test_get' (with_ssh_origin intmpclonerepo)
#else
noop
#endif
test_get' :: (Assertion -> Assertion) -> Assertion
test_get' setup = setup $ do
inmainrepo $ annexed_present annexedfile
annexed_notpresent annexedfile
git_annex "get" [annexedfile] "get of file"
inmainrepo $ annexed_present annexedfile
annexed_present annexedfile
git_annex "get" [annexedfile] "get of file already here"
inmainrepo $ annexed_present annexedfile
annexed_present annexedfile
inmainrepo $ unannexed ingitfile
unannexed ingitfile
git_annex "get" [ingitfile] "get ingitfile should be no-op"
inmainrepo $ unannexed ingitfile
unannexed ingitfile
test_move :: Assertion
test_move = test_move' intmpclonerepo
test_move_ssh_remote :: Assertion
test_move_ssh_remote =
#ifndef mingw32_HOST_OS
test_move' (with_ssh_origin intmpclonerepo)
#else
noop
#endif
test_move' :: (Assertion -> Assertion) -> Assertion
test_move' setup = setup $ do
annexed_notpresent annexedfile
inmainrepo $ annexed_present annexedfile
git_annex "move" ["--from", "origin", annexedfile] "move --from of file"
annexed_present annexedfile
inmainrepo $ annexed_notpresent annexedfile
git_annex "move" ["--from", "origin", annexedfile] "move --from of file already here"
annexed_present annexedfile
inmainrepo $ annexed_notpresent annexedfile
git_annex "move" ["--to", "origin", annexedfile] "move --to of file"
inmainrepo $ annexed_present annexedfile
annexed_notpresent annexedfile
git_annex "move" ["--to", "origin", annexedfile] "move --to of file already there"
inmainrepo $ annexed_present annexedfile
annexed_notpresent annexedfile
unannexed ingitfile
inmainrepo $ unannexed ingitfile
git_annex "move" ["--to", "origin", ingitfile] "move of ingitfile should be no-op"
unannexed ingitfile
inmainrepo $ unannexed ingitfile
git_annex "move" ["--from", "origin", ingitfile] "move of ingitfile should be no-op"
unannexed ingitfile
inmainrepo $ unannexed ingitfile
test_move_numcopies :: Assertion
test_move_numcopies = intmpclonerepo $ do
inmainrepo $ annexed_present annexedfile
git_annex "numcopies" ["2"] "setting numcopies"
git_annex "move" ["--from", "origin", annexedfile] "move of file --from remote with numcopies unsatisfied but not made worse"
annexed_present annexedfile
inmainrepo $ annexed_notpresent annexedfile
git_annex "move" ["--to", "origin", annexedfile] "move of file --to remote with numcopies unsatisfied but not made worse"
annexed_notpresent annexedfile
inmainrepo $ annexed_present annexedfile
git_annex "get" [annexedfile] "get of file"
git_annex_shouldfail "move" ["--from", "origin", annexedfile] "move of file --from remote that violates numcopies setting not allowd"
git_annex_shouldfail "move" ["--to", "origin", annexedfile] "move of file --to remote that violates numcopies setting not allowed"
test_copy :: Assertion
test_copy = intmpclonerepo $ do
annexed_notpresent annexedfile
inmainrepo $ annexed_present annexedfile
git_annex "copy" ["--from", "origin", annexedfile] "copy --from of file"
annexed_present annexedfile
inmainrepo $ annexed_present annexedfile
git_annex "copy" ["--from", "origin", annexedfile] "copy --from of file already here"
annexed_present annexedfile
inmainrepo $ annexed_present annexedfile
git_annex "copy" ["--to", "origin", annexedfile] "copy --to of file already there"
annexed_present annexedfile
inmainrepo $ annexed_present annexedfile
git_annex "move" ["--to", "origin", annexedfile] "move --to of file already there"
annexed_notpresent annexedfile
inmainrepo $ annexed_present annexedfile
unannexed ingitfile
inmainrepo $ unannexed ingitfile
git_annex "copy" ["--to", "origin", ingitfile] "copy of ingitfile should be no-op"
unannexed ingitfile
inmainrepo $ unannexed ingitfile
git_annex "copy" ["--from", "origin", ingitfile] "copy of ingitfile should be no-op"
checkregularfile ingitfile
checkcontent ingitfile
test_preferred_content :: Assertion
test_preferred_content = intmpclonerepo $ do
annexed_notpresent annexedfile
-- get/copy --auto looks only at numcopies when preferred content is not
-- set, and with 1 copy existing, does not get the file.
git_annex "get" ["--auto", annexedfile] "get --auto of file with default preferred content"
annexed_notpresent annexedfile
git_annex "copy" ["--from", "origin", "--auto", annexedfile] "copy --auto --from of file with default preferred content"
annexed_notpresent annexedfile
git_annex "wanted" [".", "standard"] "set expression to standard"
git_annex "group" [".", "client"] "set group to standard"
git_annex "get" ["--auto", annexedfile] "get --auto of file for client"
annexed_present annexedfile
git_annex "drop" [annexedfile] "drop of file"
git_annex "copy" ["--from", "origin", "--auto", annexedfile] "copy --auto --from of file for client"
annexed_present annexedfile
git_annex "ungroup" [".", "client"] "ungroup"
git_annex "wanted" [".", "standard"] "set expression to standard"
git_annex "group" [".", "manual"] "set group to manual"
-- drop --auto with manual leaves the file where it is
git_annex "drop" ["--auto", annexedfile] "drop --auto of file with manual preferred content"
annexed_present annexedfile
git_annex "drop" [annexedfile] "drop of file"
annexed_notpresent annexedfile
-- copy/get --auto with manual does not get the file
git_annex "get" ["--auto", annexedfile] "get --auto of file with manual preferred content"
annexed_notpresent annexedfile
git_annex "copy" ["--from", "origin", "--auto", annexedfile] "copy --auto --from of file with manual preferred content"
annexed_notpresent annexedfile
git_annex "ungroup" [".", "client"] "ungroup"
git_annex "wanted" [".", "exclude=*"] "set expression to exclude=*"
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "drop" ["--auto", annexedfile] "drop --auto of file with exclude=*"
annexed_notpresent annexedfile
git_annex "get" ["--auto", annexedfile] "get --auto of file with exclude=*"
annexed_notpresent annexedfile
test_lock :: Assertion
test_lock = intmpclonerepo $ do
annexed_notpresent annexedfile
-- regression test: unlock of newly added, not committed file
-- should not fail.
writecontent "newfile" "foo"
git_annex "add" ["newfile"] "add new file"
git_annex "unlock" ["newfile"] "unlock on newly added, never committed file"
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "unlock" [annexedfile] "unlock"
unannexed annexedfile
-- write different content, to verify that lock
-- throws it away
changecontent annexedfile
writecontent annexedfile $ content annexedfile ++ "foo"
git_annex_shouldfail "lock" [annexedfile] "lock without --force should not be allowed"
git_annex "lock" ["--force", annexedfile] "lock --force"
-- The original content of an unlocked file is not always
-- preserved after modification, so re-get it.
git_annex "get" [annexedfile] "get of file after lock --force"
annexed_present_locked annexedfile
git_annex "unlock" [annexedfile] "unlock"
unannexed annexedfile
changecontent annexedfile
git "add" [annexedfile] "add of modified file"
runchecks [checkregularfile, checkwritable] annexedfile
c <- readFile annexedfile
assertEqual "content of modified file" c (changedcontent annexedfile)
git_annex_shouldfail "drop" [annexedfile]
"drop with no known copy of modified file should not be allowed"
-- Regression test: lock --force when work tree file
-- was modified lost the (unmodified) annex object.
-- (Only occurred when the keys database was out of sync.)
test_lock_force :: Assertion
test_lock_force = intmpclonerepo $ do
git_annex "upgrade" [] "upgrade"
git_annex "get" [annexedfile] "get of file"
git_annex "unlock" [annexedfile] "unlock"
annexeval $ do
Just k <- Annex.WorkTree.lookupKey (toRawFilePath annexedfile)
Database.Keys.removeInodeCaches k
Database.Keys.closeDb
liftIO . removeWhenExistsWith R.removeLink
=<< Annex.fromRepo Annex.Locations.gitAnnexKeysDbIndexCache
writecontent annexedfile "test_lock_force content"
git_annex_shouldfail "lock" [annexedfile] "lock of modified file should not be allowed"
git_annex "lock" ["--force", annexedfile] "lock --force of modified file"
annexed_present_locked annexedfile
test_edit :: Assertion
test_edit = test_edit' False
test_edit_precommit :: Assertion
test_edit_precommit = test_edit' True
test_edit' :: Bool -> Assertion
test_edit' precommit = intmpclonerepo $ do
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "edit" [annexedfile] "edit"
unannexed annexedfile
changecontent annexedfile
git "add" [annexedfile] "git add of edited file"
if precommit
then git_annex "pre-commit" [] "pre-commit"
else git "commit" ["-q", "-m", "contentchanged"] "git commit of edited file"
runchecks [checkregularfile, checkwritable] annexedfile
c <- readFile annexedfile
assertEqual "content of modified file" c (changedcontent annexedfile)
git_annex_shouldfail "drop" [annexedfile] "drop no known copy of modified file should not be allowed"
test_partial_commit :: Assertion
test_partial_commit = intmpclonerepo $ do
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "unlock" [annexedfile] "unlock"
changecontent annexedfile
git "commit" ["-q", "-m", "test", annexedfile]
"partial commit of unlocked file should be allowed"
test_fix :: Assertion
test_fix = intmpclonerepo $ unlessM (hasUnlockedFiles <$> getTestMode) $ do
annexed_notpresent annexedfile
git_annex "fix" [annexedfile] "fix of not present"
annexed_notpresent annexedfile
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "fix" [annexedfile] "fix of present file"
annexed_present annexedfile
createDirectory subdir
git "mv" [annexedfile, subdir] "git mv"
git_annex "fix" [newfile] "fix of moved file"
runchecks [checklink, checkunwritable] newfile
c <- readFile newfile
assertEqual "content of moved file" c (content annexedfile)
where
subdir = "s"
newfile = subdir ++ "/" ++ annexedfile
test_trust :: Assertion
test_trust = intmpclonerepo $ do
git_annex "trust" ["--force", repo] "trust"
trustcheck Logs.Trust.Trusted "trusted 1"
git_annex "trust" ["--force", repo] "trust of trusted"
trustcheck Logs.Trust.Trusted "trusted 2"
git_annex "untrust" [repo] "untrust"
trustcheck Logs.Trust.UnTrusted "untrusted 1"
git_annex "untrust" [repo] "untrust of untrusted"
trustcheck Logs.Trust.UnTrusted "untrusted 2"
git_annex "dead" [repo] "dead"
trustcheck Logs.Trust.DeadTrusted "deadtrusted 1"
git_annex "dead" [repo] "dead of dead"
trustcheck Logs.Trust.DeadTrusted "deadtrusted 2"
git_annex "semitrust" [repo] "semitrust"
trustcheck Logs.Trust.SemiTrusted "semitrusted 1"
git_annex "semitrust" [repo] "semitrust of semitrusted"
trustcheck Logs.Trust.SemiTrusted "semitrusted 2"
where
repo = "origin"
trustcheck expected msg = do
present <- annexeval $ do
l <- Logs.Trust.trustGet expected
u <- Remote.nameToUUID repo
return $ u `elem` l
assertBool msg present
test_fsck_basic :: Assertion
test_fsck_basic = intmpclonerepo $ do
git_annex "fsck" [] "fsck"
git_annex "numcopies" ["2"] "numcopies config"
fsck_should_fail "numcopies unsatisfied"
git_annex "numcopies" ["1"] "numcopies config"
corrupt annexedfile
corrupt sha1annexedfile
where
corrupt f = do
git_annex "get" [f] "get of file"
Utility.FileMode.allowWrite (toRawFilePath f)
writecontent f (changedcontent f)
ifM (hasUnlockedFiles <$> getTestMode)
( git_annex "fsck" []"fsck on unlocked file with changed file content"
, git_annex_shouldfail "fsck" [] "fsck with corrupted file content should error"
)
git_annex "fsck" [] "second fsck, after first fsck should have fixed problem"
test_fsck_bare :: Assertion
test_fsck_bare = intmpbareclonerepo $
git_annex "fsck" [] "fsck"
test_fsck_localuntrusted :: Assertion
test_fsck_localuntrusted = intmpclonerepo $ do
git_annex "get" [annexedfile] "get"
git_annex "untrust" ["origin"] "untrust of origin repo"
git_annex "untrust" ["."] "untrust of current repo"
fsck_should_fail "content only available in untrusted (current) repository"
git_annex "trust" ["--force", "."] "trust of current repo"
git_annex "fsck" [annexedfile] "fsck on file present in trusted repo"
test_fsck_remoteuntrusted :: Assertion
test_fsck_remoteuntrusted = intmpclonerepo $ do
git_annex "numcopies" ["2"] "numcopies config"
git_annex "get" [annexedfile] "get"
git_annex "get" [sha1annexedfile] "get"
git_annex "fsck" [] "fsck with numcopies=2 and 2 copies"
git_annex "untrust" ["origin"] "untrust of origin"
fsck_should_fail "content not replicated to enough non-untrusted repositories"
test_fsck_fromremote :: Assertion
test_fsck_fromremote = intmpclonerepo $ do
git_annex "fsck" ["--from", "origin"] "fsck --from origin"
fsck_should_fail :: String -> Assertion
fsck_should_fail m = git_annex_shouldfail "fsck" []
("fsck should not succeed with " ++ m)
test_migrate :: Assertion
test_migrate = test_migrate' False
test_migrate_via_gitattributes :: Assertion
test_migrate_via_gitattributes = test_migrate' True
test_migrate' :: Bool -> Assertion
test_migrate' usegitattributes = intmpclonerepo $ do
annexed_notpresent annexedfile
annexed_notpresent sha1annexedfile
git_annex "migrate" [annexedfile] "migrate of not present"
git_annex "migrate" [sha1annexedfile] "migrate of not present"
git_annex "get" [annexedfile] "get of file"
git_annex "get" [sha1annexedfile] "get of file"
annexed_present annexedfile
annexed_present sha1annexedfile
if usegitattributes
then do
writeFile ".gitattributes" "* annex.backend=SHA1"
git_annex "migrate" [sha1annexedfile]
"migrate sha1annexedfile"
git_annex "migrate" [annexedfile]
"migrate annexedfile"
else do
git_annex "migrate" [sha1annexedfile, "--backend", "SHA1"]
"migrate sha1annexedfile"
git_annex "migrate" [annexedfile, "--backend", "SHA1"]
"migrate annexedfile"
annexed_present annexedfile
annexed_present sha1annexedfile
checkbackend annexedfile backendSHA1
checkbackend sha1annexedfile backendSHA1
-- check that reversing a migration works
writeFile ".gitattributes" "* annex.backend=SHA256"
git_annex "migrate" [sha1annexedfile] "migrate sha1annexedfile"
git_annex "migrate" [annexedfile] "migrate annexedfile"
annexed_present annexedfile
annexed_present sha1annexedfile
checkbackend annexedfile backendSHA256
checkbackend sha1annexedfile backendSHA256
test_unused :: Assertion
test_unused = intmpclonerepo $ do
checkunused [] "in new clone"
git_annex "get" [annexedfile] "get of file"
git_annex "get" [sha1annexedfile] "get of file"
annexedfilekey <- getKey backendSHA256E annexedfile
sha1annexedfilekey <- getKey backendSHA1 sha1annexedfile
checkunused [] "after get"
git "rm" ["-fq", annexedfile] "git rm"
checkunused [] "after rm"
-- commit the rm, and when on an adjusted branch, sync it back to
-- the master branch
git_annex "sync" ["--no-push", "--no-pull"] "git-annex sync"
checkunused [] "after commit"
-- unused checks origin/master; once it's gone it is really unused
git "remote" ["rm", "origin"] "git remote rm origin"
checkunused [annexedfilekey] "after origin branches are gone"
git "rm" ["-fq", sha1annexedfile] "git rm"
git_annex "sync" ["--no-push", "--no-pull"] "git-annex sync"
checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile"
-- good opportunity to test dropkey also
git_annex "dropkey" ["--force", Key.serializeKey annexedfilekey] "dropkey"
checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Key.serializeKey annexedfilekey)
git_annex_shouldfail "dropunused" ["1"] "dropunused should not be allowed without --force"
git_annex "dropunused" ["--force", "1"] "dropunused"
checkunused [] "after dropunused"
git_annex_shouldfail "dropunused" ["--force", "10", "501"] "dropunused on bogus numbers"
-- Unused used to miss renamed symlinks that were not staged
-- and pointed at annexed content, and think that content was unused.
-- This is only relevant when using locked files; if the file is
-- unlocked, the work tree file has the content, and there's no way
-- to associate it with the key.
unlessM (hasUnlockedFiles <$> getTestMode) $ do
writecontent "unusedfile" "unusedcontent"
git_annex "add" ["unusedfile"] "add of unusedfile"
unusedfilekey <- getKey backendSHA256E "unusedfile"
renameFile "unusedfile" "unusedunstagedfile"
git "rm" ["-qf", "unusedfile"] "git rm"
checkunused [] "with unstaged link"
removeFile "unusedunstagedfile"
checkunused [unusedfilekey] "with renamed link deleted"
-- unused used to miss symlinks that were deleted or modified
-- manually
writecontent "unusedfile" "unusedcontent"
git_annex "add" ["unusedfile"] "add of unusedfile"
git "add" ["unusedfile"] "git add"
unusedfilekey' <- getKey backendSHA256E "unusedfile"
checkunused [] "with staged deleted link"
git "rm" ["-qf", "unusedfile"] "git rm"
checkunused [unusedfilekey'] "with staged link deleted"
-- unused used to false positive on symlinks that were
-- deleted or modified manually, but not staged as such
writecontent "unusedfile" "unusedcontent"
git_annex "add" ["unusedfile"] "add of unusedfile"
git "add" ["unusedfile"] "git add"
checkunused [] "with staged file"
removeFile "unusedfile"
checkunused [] "with staged deleted file"
-- When an unlocked file is modified, git diff will cause git-annex
-- to add its content to the repository. Make sure that's not
-- found as unused.
whenM (hasUnlockedFiles <$> getTestMode) $ do
let f = "unlockedfile"
writecontent f "unlockedcontent1"
git "add" ["unlockedfile"] "git add"
checkunused [] "with unlocked file before modification"
writecontent f "unlockedcontent2"
checkunused [] "with unlocked file after modification"
git_shouldfail "diff" ["--quiet", f] "git diff should exit nonzero when unlocked file is modified"
-- still nothing unused because one version is in the index
-- and the other is in the work tree
checkunused [] "with unlocked file after git diff"
where
checkunused expectedkeys desc = do
git_annex "unused" [] "unused"
unusedmap <- annexeval $ Logs.Unused.readUnusedMap mempty
let unusedkeys = M.elems unusedmap
assertEqual ("unused keys differ " ++ desc)
(sort expectedkeys) (sort unusedkeys)
test_describe :: Assertion
test_describe = intmpclonerepo $ do
git_annex "describe" [".", "this repo"] "describe 1"
git_annex "describe" ["origin", "origin repo"] "describe 2"
test_find :: Assertion
test_find = intmpclonerepo $ do
annexed_notpresent annexedfile
git_annex_expectoutput "find" [] []
git_annex "get" [annexedfile] "get"
annexed_present annexedfile
annexed_notpresent sha1annexedfile
git_annex_expectoutput "find" [] [annexedfile]
git_annex_expectoutput "find" ["--exclude", annexedfile, "--and", "--exclude", sha1annexedfile] []
git_annex_expectoutput "find" ["--include", annexedfile] [annexedfile]
git_annex_expectoutput "find" ["--not", "--in", "origin"] []
git_annex_expectoutput "find" ["--copies", "1", "--and", "--not", "--copies", "2"] [sha1annexedfile]
git_annex_expectoutput "find" ["--inbackend", "SHA1"] [sha1annexedfile]
git_annex_expectoutput "find" ["--inbackend", "WORM"] []
{- --include=* should match files in subdirectories too,
- and --exclude=* should exclude them. -}
createDirectory "dir"
writecontent "dir/subfile" "subfile"
git_annex "add" ["dir"] "add of subdir"
git_annex_expectoutput "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"]
git_annex_expectoutput "find" ["--exclude", "*"] []
test_merge :: Assertion
test_merge = intmpclonerepo $
git_annex "merge" [] "merge"
test_info :: Assertion
test_info = intmpclonerepo $ do
json <- BU8.fromString <$> git_annex_output "info" ["--json"]
case Utility.Aeson.eitherDecode json :: Either String Utility.Aeson.Value of
Right _ -> return ()
Left e -> assertFailure e
test_version :: Assertion
test_version = intmpclonerepo $
git_annex "version" [] "version"
test_sync :: Assertion
test_sync = intmpclonerepo $ do
git_annex "sync" [] "sync"
{- Regression test for bug fixed in
- 039e83ed5d1a11fd562cce55b8429c840d72443e, where a present
- wanted file was dropped. -}
git_annex "get" [annexedfile] "get"
git_annex_expectoutput "find" ["--in", "."] [annexedfile]
git_annex "wanted" [".", "present"] "wanted"
git_annex "sync" ["--content"] "sync"
git_annex_expectoutput "find" ["--in", "."] [annexedfile]
git_annex "drop" [annexedfile] "drop"
git_annex_expectoutput "find" ["--in", "."] []
git_annex "sync" ["--content"] "sync"
git_annex_expectoutput "find" ["--in", "."] []
{- Regression test for the concurrency bug fixed in
- 667d38a8f11c1ee8f256cdbd80e225c2bae06595 -}
test_concurrent_get_of_dup_key_regression :: Assertion
test_concurrent_get_of_dup_key_regression = intmpclonerepo $ do
makedup dupfile
-- This was sufficient currency to trigger the bug.
git_annex "get" ["-J1", annexedfile, dupfile]
"concurrent get -J1 with dup"
git_annex "drop" ["-J1"]
"drop with dup"
-- With -J2, one more dup file was needed to trigger the bug.
makedup dupfile2
git_annex "get" ["-J2", annexedfile, dupfile, dupfile2]
"concurrent get -J2 with dup"
git_annex "drop" ["-J2"]
"drop with dup"
where
dupfile = annexedfile ++ "2"
dupfile2 = annexedfile ++ "3"
makedup f = do
Utility.CopyFile.copyFileExternal Utility.CopyFile.CopyAllMetaData annexedfile f
@? "copying annexed file failed"
git "add" [f] "git add"
{- Regression test for union merge bug fixed in
- 0214e0fb175a608a49b812d81b4632c081f63027 -}
test_union_merge_regression :: Assertion
test_union_merge_regression =
{- We need 3 repos to see this bug. -}
withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 ->
withtmpclonerepo $ \r3 -> do
forM_ [r1, r2, r3] $ \r -> indir r $ do
when (r /= r1) $
git "remote" ["add", "r1", "../../" ++ r1] "remote add"
when (r /= r2) $
git "remote" ["add", "r2", "../../" ++ r2] "remote add"
when (r /= r3) $
git "remote" ["add", "r3", "../../" ++ r3] "remote add"
git_annex "get" [annexedfile] "get"
git "remote" ["rm", "origin"] "remote rm"
forM_ [r3, r2, r1] $ \r -> indir r $
git_annex "sync" [] ("sync in " ++ r)
forM_ [r3, r2] $ \r -> indir r $
git_annex "drop" ["--force", annexedfile] ("drop in " ++ r)
indir r1 $ do
git_annex "sync" [] "sync in r1"
git_annex_expectoutput "find" ["--in", "r3"] []
{- This was the bug. The sync
- mangled location log data and it
- thought the file was still in r2 -}
git_annex_expectoutput "find" ["--in", "r2"] []
{- Regression test for the automatic conflict resolution bug fixed
- in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -}
test_conflict_resolution_movein_regression :: Assertion
test_conflict_resolution_movein_regression = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do
let rname r = if r == r1 then "r1" else "r2"
forM_ [r1, r2] $ \r -> indir r $ do
{- Get all files, see check below. -}
git_annex "get" [] "get"
disconnectOrigin
pair r1 r2
forM_ [r1, r2] $ \r -> indir r $ do
{- Set up a conflict. -}
let newcontent = content annexedfile ++ rname r
git_annex "unlock" [annexedfile] "unlock"
writecontent annexedfile newcontent
{- Sync twice in r1 so it gets the conflict resolution
- update from r2 -}
forM_ [r1, r2, r1] $ \r -> indir r $
git_annex "sync" ["--force"] ("sync in " ++ rname r)
{- After the sync, it should be possible to get all
- files. This includes both sides of the conflict,
- although the filenames are not easily predictable.
-
- The bug caused one repo to be missing the content
- of the file that had been put in it. -}
forM_ [r1, r2] $ \r -> indir r $ do
git_annex "get" [] ("get all files after merge conflict resolution in " ++ rname r)
{- Simple case of conflict resolution; 2 different versions of annexed
- file. -}
test_conflict_resolution :: Assertion
test_conflict_resolution =
withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do
indir r1 $ do
disconnectOrigin
writecontent conflictor "conflictor1"
add_annex conflictor "add conflicter"
git_annex "sync" [] "sync in r1"
indir r2 $ do
disconnectOrigin
writecontent conflictor "conflictor2"
add_annex conflictor "add conflicter"
git_annex "sync" [] "sync in r2"
pair r1 r2
forM_ [r1,r2,r1] $ \r -> indir r $
git_annex "sync" [] "sync"
checkmerge "r1" r1
checkmerge "r2" r2
where
conflictor = "conflictor"
variantprefix = conflictor ++ ".variant"
checkmerge what d = do
l <- getDirectoryContents d
let v = filter (variantprefix `isPrefixOf`) l
length v == 2
@? (what ++ " not exactly 2 variant files in: " ++ show l)
conflictor `notElem` l @? ("conflictor still present after conflict resolution")
indir d $ do
git_annex "get" v "get"
git_annex_expectoutput "find" v v
{- Conflict resolution while in an adjusted branch. -}
test_conflict_resolution_adjusted_branch :: Assertion
test_conflict_resolution_adjusted_branch =
withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r2) $ do
indir r1 $ do
disconnectOrigin
writecontent conflictor "conflictor1"
add_annex conflictor "add conflicter"
git_annex "sync" [] "sync in r1"
indir r2 $ do
disconnectOrigin
writecontent conflictor "conflictor2"
add_annex conflictor "add conflicter"
git_annex "sync" [] "sync in r2"
-- We might be in an adjusted branch
-- already, when eg on a crippled
-- filesystem. So, --force it.
git_annex "adjust" ["--unlock", "--force"] "adjust"
pair r1 r2
forM_ [r1,r2,r1] $ \r -> indir r $
git_annex "sync" [] "sync"
checkmerge "r1" r1
checkmerge "r2" r2
where
conflictor = "conflictor"
variantprefix = conflictor ++ ".variant"
checkmerge what d = do
l <- getDirectoryContents d
let v = filter (variantprefix `isPrefixOf`) l
length v == 2
@? (what ++ " not exactly 2 variant files in: " ++ show l)
conflictor `notElem` l @? ("conflictor still present after conflict resolution")
indir d $ do
git_annex "get" v "get"
git_annex_expectoutput "find" v v
{- Check merge conflict resolution when one side is an annexed
- file, and the other is a directory. -}
test_mixed_conflict_resolution :: Assertion
test_mixed_conflict_resolution = do
check True
check False
where
check inr1 = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do
indir r1 $ do
disconnectOrigin
writecontent conflictor "conflictor"
add_annex conflictor "add conflicter"
git_annex "sync" [] "sync in r1"
indir r2 $ do
disconnectOrigin
createDirectory conflictor
writecontent subfile "subfile"
add_annex conflictor "add conflicter"
git_annex "sync" [] "sync in r2"
pair r1 r2
let l = if inr1 then [r1, r2] else [r2, r1]
forM_ l $ \r -> indir r $
git_annex "sync" [] "sync in mixed conflict"
checkmerge "r1" r1
checkmerge "r2" r2
conflictor = "conflictor"
subfile = conflictor </> "subfile"
variantprefix = conflictor ++ ".variant"
checkmerge what d = do
doesDirectoryExist (d </> conflictor)
@? (d ++ " conflictor directory missing")
l <- getDirectoryContents d
let v = filter (variantprefix `isPrefixOf`) l
not (null v)
@? (what ++ " conflictor variant file missing in: " ++ show l )
length v == 1
@? (what ++ " too many variant files in: " ++ show v)
indir d $ do
git_annex "get" (conflictor:v) ("get in " ++ what)
git_annex_expectoutput "find" [conflictor] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath subfile))]
git_annex_expectoutput "find" v v
{- Check merge conflict resolution when both repos start with an annexed
- file; one modifies it, and the other deletes it. -}
test_remove_conflict_resolution :: Assertion
test_remove_conflict_resolution = do
check True
check False
where
check inr1 = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do
indir r1 $ do
disconnectOrigin
writecontent conflictor "conflictor"
add_annex conflictor "add conflicter"
git_annex "sync" [] "sync in r1"
indir r2 $
disconnectOrigin
pair r1 r2
indir r2 $ do
git_annex "sync" [] "sync in r2"
git_annex "get" [conflictor] "get conflictor"
git_annex "unlock" [conflictor] "unlock conflictor"
writecontent conflictor "newconflictor"
indir r1 $
removeWhenExistsWith R.removeLink (toRawFilePath conflictor)
let l = if inr1 then [r1, r2, r1] else [r2, r1, r2]
forM_ l $ \r -> indir r $
git_annex "sync" [] "sync"
checkmerge "r1" r1
checkmerge "r2" r2
conflictor = "conflictor"
variantprefix = conflictor ++ ".variant"
checkmerge what d = do
l <- getDirectoryContents d
let v = filter (variantprefix `isPrefixOf`) l
not (null v)
@? (what ++ " conflictor variant file missing in: " ++ show l )
length v == 1
@? (what ++ " too many variant files in: " ++ show v)
{- Check merge confalict resolution when a file is annexed in one repo,
- and checked directly into git in the other repo.
-}
test_nonannexed_file_conflict_resolution :: Assertion
test_nonannexed_file_conflict_resolution = do
check True
check False
where
check inr1 = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do
indir r1 $ do
disconnectOrigin
writecontent conflictor "conflictor"
add_annex conflictor "add conflicter"
git_annex "sync" [] "sync in r1"
indir r2 $ do
disconnectOrigin
writecontent conflictor nonannexed_content
git "config"
[ "annex.largefiles"
, "exclude=" ++ ingitfile ++ " and exclude=" ++ conflictor
] "git config annex.largefiles"
git "add" [conflictor] "git add conflictor"
git_annex "sync" [] "sync in r2"
pair r1 r2
let l = if inr1 then [r1, r2] else [r2, r1]
forM_ l $ \r -> indir r $
git_annex "sync" [] "sync"
checkmerge "r1" r1
checkmerge "r2" r2
conflictor = "conflictor"
nonannexed_content = "nonannexed"
variantprefix = conflictor ++ ".variant"
checkmerge what d = do
l <- getDirectoryContents d
let v = filter (variantprefix `isPrefixOf`) l
not (null v)
@? (what ++ " conflictor variant file missing in: " ++ show l )
length v == 1
@? (what ++ " too many variant files in: " ++ show v)
conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l)
s <- catchMaybeIO (readFile (d </> conflictor))
s == Just nonannexed_content
@? (what ++ " wrong content for nonannexed file: " ++ show s)
{- Check merge conflict resolution when a file is annexed in one repo,
- and is a non-git-annex symlink in the other repo.
-
- Test can only run when coreSymlinks is supported, because git needs to
- be able to check out the non-git-annex symlink.
-}
test_nonannexed_symlink_conflict_resolution :: Assertion
test_nonannexed_symlink_conflict_resolution = do
check True
check False
where
check inr1 = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 ->
whenM (checkRepo (Types.coreSymlinks <$> Annex.getGitConfig) r1) $ do
indir r1 $ do
disconnectOrigin
writecontent conflictor "conflictor"
add_annex conflictor "add conflicter"
git_annex "sync" [] "sync in r1"
indir r2 $ do
disconnectOrigin
createSymbolicLink symlinktarget "conflictor"
git "add" [conflictor] "git add conflictor"
git_annex "sync" [] "sync in r2"
pair r1 r2
let l = if inr1 then [r1, r2] else [r2, r1]
forM_ l $ \r -> indir r $
git_annex "sync" [] "sync"
checkmerge "r1" r1
checkmerge "r2" r2
conflictor = "conflictor"
symlinktarget = "dummy-target"
variantprefix = conflictor ++ ".variant"
checkmerge what d = do
l <- getDirectoryContents d
let v = filter (variantprefix `isPrefixOf`) l
not (null v)
@? (what ++ " conflictor variant file missing in: " ++ show l )
length v == 1
@? (what ++ " too many variant files in: " ++ show v)
conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l)
s <- catchMaybeIO (readSymbolicLink (d </> conflictor))
s == Just symlinktarget
@? (what ++ " wrong target for nonannexed symlink: " ++ show s)
{- Check merge conflict resolution when there is a local file,
- that is not staged or committed, that conflicts with what's being added
- from the remmote.
-
- Case 1: Remote adds file named conflictor; local has a file named
- conflictor.
-
- Case 2: Remote adds conflictor/file; local has a file named conflictor.
-}
test_uncommitted_conflict_resolution :: Assertion
test_uncommitted_conflict_resolution = do
check conflictor
check (conflictor </> "file")
where
check remoteconflictor = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do
indir r1 $ do
disconnectOrigin
createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath remoteconflictor)))
writecontent remoteconflictor annexedcontent
add_annex conflictor "add remoteconflicter"
git_annex "sync" [] "sync in r1"
indir r2 $ do
disconnectOrigin
writecontent conflictor localcontent
pair r1 r2
-- this case is intentionally not handled
-- since the user can recover on their own easily
indir r2 $ git_annex_shouldfail "sync" [] "sync should not succeed"
conflictor = "conflictor"
localcontent = "local"
annexedcontent = "annexed"
{- On Windows/FAT, repeated conflict resolution sometimes
- lost track of whether a file was a symlink.
-}
test_conflict_resolution_symlink_bit :: Assertion
test_conflict_resolution_symlink_bit = unlessM (hasUnlockedFiles <$> getTestMode) $
withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 ->
withtmpclonerepo $ \r3 -> do
indir r1 $ do
writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter"
git_annex "sync" [] "sync in r1"
check_is_link conflictor "r1"
indir r2 $ do
createDirectory conflictor
writecontent (conflictor </> "subfile") "subfile"
git_annex "add" [conflictor] "add conflicter"
git_annex "sync" [] "sync in r2"
check_is_link (conflictor </> "subfile") "r2"
indir r3 $ do
writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter"
git_annex "sync" [] "sync in r1"
check_is_link (conflictor </> "subfile") "r3"
where
conflictor = "conflictor"
check_is_link f what = do
git_annex_expectoutput "find" ["--include=*", f] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath f))]
l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f]
all (\i -> Git.Types.toTreeItemType (Git.LsTree.mode i) == Just Git.Types.TreeSymlink) l
@? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l)
{- An unlocked file that conflicts with a locked file should be resolved
- in favor of the unlocked file, with no variant files, as long as they
- both point to the same key. -}
test_mixed_lock_conflict_resolution :: Assertion
test_mixed_lock_conflict_resolution =
withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do
indir r1 $ do
disconnectOrigin
writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter"
git_annex "sync" [] "sync in r1"
indir r2 $ do
disconnectOrigin
writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter"
git_annex "unlock" [conflictor] "unlock conflicter"
git_annex "sync" [] "sync in r2"
pair r1 r2
forM_ [r1,r2,r1] $ \r -> indir r $
git_annex "sync" [] "sync"
checkmerge "r1" r1
checkmerge "r2" r2
where
conflictor = "conflictor"
variantprefix = conflictor ++ ".variant"
checkmerge what d = indir d $ do
l <- getDirectoryContents "."
let v = filter (variantprefix `isPrefixOf`) l
length v == 0
@? (what ++ " not exactly 0 variant files in: " ++ show l)
conflictor `elem` l @? ("conflictor not present after conflict resolution")
git_annex "get" [conflictor] "get"
git_annex_expectoutput "find" [conflictor] [conflictor]
-- regular file because it's unlocked
checkregularfile conflictor
{- Regression test for a bad merge between two adjusted branch repos,
- where the same file is added to both independently. The bad merge
- emptied the whole tree. -}
test_adjusted_branch_merge_regression :: Assertion
test_adjusted_branch_merge_regression = do
withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r1) $ do
pair r1 r2
setup r1
setup r2
checkmerge "r1" r1
checkmerge "r2" r2
where
conflictor = "conflictor"
setup r = indir r $ whensupported $ do
disconnectOrigin
git_annex "upgrade" [] "upgrade"
git_annex "adjust" ["--unlock", "--force"] "adjust"
writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter"
git_annex "sync" [] "sync"
checkmerge what d = indir d $ whensupported $ do
git_annex "sync" [] ("sync should not work in " ++ what)
l <- getDirectoryContents "."
conflictor `elem` l
@? ("conflictor not present after merge in " ++ what)
-- Currently this fails on FAT, for unknown reasons not to
-- do with what it's intended to test.
whensupported = unlessM (annexeval Config.crippledFileSystem)
{- Regression test for a bug in adjusted branch syncing code, where adding
- a subtree to an existing tree lost files. -}
test_adjusted_branch_subtree_regression :: Assertion
test_adjusted_branch_subtree_regression =
withtmpclonerepo $ \r -> whenM (adjustedbranchsupported r) $ do
indir r $ do
disconnectOrigin
origbranch <- annexeval origBranch
git_annex "upgrade" [] "upgrade"
git_annex "adjust" ["--unlock", "--force"] "adjust"
createDirectoryIfMissing True "a/b/c"
writecontent "a/b/c/d" "foo"
git_annex "add" ["a/b/c"] "add a/b/c"
git_annex "sync" [] "sync"
createDirectoryIfMissing True "a/b/x"
writecontent "a/b/x/y" "foo"
git_annex "add" ["a/b/x"] "add a/b/x"
git_annex "sync" [] "sync"
git "checkout" [origbranch] "git checkout"
doesFileExist "a/b/x/y" @? ("a/b/x/y missing from master after adjusted branch sync")
{- Set up repos as remotes of each other. -}
pair :: FilePath -> FilePath -> Assertion
pair r1 r2 = forM_ [r1, r2] $ \r -> indir r $ do
when (r /= r1) $
git "remote" ["add", "r1", "../../" ++ r1] "remote add"
when (r /= r2) $
git "remote" ["add", "r2", "../../" ++ r2] "remote add"
test_map :: Assertion
test_map = intmpclonerepo $ do
-- set descriptions, that will be looked for in the map
git_annex "describe" [".", "this repo"] "describe 1"
git_annex "describe" ["origin", "origin repo"] "describe 2"
-- --fast avoids it running graphviz, not a build dependency
git_annex "map" ["--fast"] "map"
test_uninit :: Assertion
test_uninit = intmpclonerepo $ do
git_annex "get" [] "get"
annexed_present annexedfile
-- any exit status is accepted; does abnormal exit
git_annex' (const True) "uninit" [] "uninit"
checkregularfile annexedfile
doesDirectoryExist ".git" @? ".git vanished in uninit"
test_uninit_inbranch :: Assertion
test_uninit_inbranch = intmpclonerepo $ do
git "checkout" ["git-annex"] "git checkout git-annex"
git_annex_shouldfail "uninit" [] "uninit should not succeed when git-annex branch is checked out"
test_upgrade :: Assertion
test_upgrade = intmpclonerepo $
git_annex "upgrade" [] "upgrade"
test_whereis :: Assertion
test_whereis = intmpclonerepo $ do
annexed_notpresent annexedfile
git_annex "whereis" [annexedfile] "whereis on non-present file"
git_annex "untrust" ["origin"] "untrust"
git_annex_shouldfail "whereis" [annexedfile] "whereis should exit nonzero on non-present file only present in untrusted repo"
git_annex "get" [annexedfile] "get"
annexed_present annexedfile
git_annex "whereis" [annexedfile] "whereis on present file"
test_hook_remote :: Assertion
test_hook_remote = intmpclonerepo $ do
#ifndef mingw32_HOST_OS
git_annex "initremote" (words "foo type=hook encryption=none hooktype=foo") "initremote"
createDirectory dir
git_config "annex.foo-store-hook" $
"cp $ANNEX_FILE " ++ loc
git_config "annex.foo-retrieve-hook" $
"cp " ++ loc ++ " $ANNEX_FILE"
git_config "annex.foo-remove-hook" $
"rm -f " ++ loc
git_config "annex.foo-checkpresent-hook" $
"if [ -e " ++ loc ++ " ]; then echo $ANNEX_KEY; fi"
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "copy" [annexedfile, "--to", "foo"] "copy --to hook remote"
annexed_present annexedfile
git_annex "drop" [annexedfile, "--numcopies=2"] "drop"
annexed_notpresent annexedfile
git_annex "move" [annexedfile, "--from", "foo"] "move --from hook remote"
annexed_present annexedfile
git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] "drop should not be allowed with numcopies=2"
annexed_present annexedfile
where
dir = "dir"
loc = dir ++ "/$ANNEX_KEY"
git_config k v = git "config" [k, v] "git config"
#else
-- this test doesn't work in Windows TODO
noop
#endif
test_directory_remote :: Assertion
test_directory_remote = intmpclonerepo $ do
createDirectory "dir"
git_annex "initremote" (words "foo type=directory encryption=none directory=dir") "initremote"
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "copy" [annexedfile, "--to", "foo"] "copy --to directory remote"
annexed_present annexedfile
git_annex "drop" [annexedfile, "--numcopies=2"] "drop"
annexed_notpresent annexedfile
git_annex "move" [annexedfile, "--from", "foo"] "move --from directory remote"
annexed_present annexedfile
git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] "drop should not be allowed with numcopies=2"
annexed_present annexedfile
test_rsync_remote :: Assertion
test_rsync_remote = intmpclonerepo $ do
#ifndef mingw32_HOST_OS
createDirectory "dir"
git_annex "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") "initremote"
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "copy" [annexedfile, "--to", "foo"] "copy --to rsync remote"
annexed_present annexedfile
git_annex "drop" [annexedfile, "--numcopies=2"] "drop"
annexed_notpresent annexedfile
git_annex "move" [annexedfile, "--from", "foo"] "move --from rsync remote"
annexed_present annexedfile
git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] "drop should not be allowed with numcopies=2"
annexed_present annexedfile
#else
noop
#endif
test_bup_remote :: Assertion
test_bup_remote = intmpclonerepo $ when BuildInfo.bup $ do
-- bup special remote needs an absolute path
dir <- fromRawFilePath <$> absPath (toRawFilePath "dir")
createDirectory dir
git_annex "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) "initremote"
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "copy" [annexedfile, "--to", "foo"] "copy --to bup remote"
annexed_present annexedfile
git_annex "drop" [annexedfile, "--numcopies=2"] "drop"
annexed_notpresent annexedfile
git_annex "copy" [annexedfile, "--from", "foo"] "copy --from bup remote"
annexed_present annexedfile
git_annex "move" [annexedfile, "--from", "foo"] "move --from bup remote"
annexed_present annexedfile
-- gpg is not a build dependency, so only test when it's available
test_crypto :: Assertion
#ifndef mingw32_HOST_OS
test_crypto = do
testscheme "shared"
testscheme "hybrid"
testscheme "pubkey"
where
gpgcmd = Utility.Gpg.mkGpgCmd Nothing
testscheme scheme = do
abstmp <- fromRawFilePath <$> absPath (toRawFilePath tmpdir)
testscheme' scheme abstmp
testscheme' scheme abstmp = intmpclonerepo $ do
gpgtmp <- (</> "gpgtmp") . fromRawFilePath
<$> relPathCwdToFile (toRawFilePath abstmp)
createDirectoryIfMissing False gpgtmp
Utility.Gpg.testTestHarness gpgtmp gpgcmd
@? "test harness self-test failed"
void $ Utility.Gpg.testHarness gpgtmp gpgcmd $ do
createDirectory "dir"
let initps =
[ "foo"
, "type=directory"
, "encryption=" ++ scheme
, "directory=dir"
, "highRandomQuality=false"
] ++ if scheme `elem` ["hybrid","pubkey"]
then ["keyid=" ++ Utility.Gpg.testKeyId]
else []
git_annex "initremote" initps "initremote"
git_annex_shouldfail "initremote" initps "initremote should not work when run twice in a row"
git_annex "enableremote" initps "enableremote"
git_annex "enableremote" initps "enableremote when run twice in a row"
git_annex "get" [annexedfile] "get of file"
annexed_present annexedfile
git_annex "copy" [annexedfile, "--to", "foo"] "copy --to encrypted remote"
(c,k) <- annexeval $ do
uuid <- Remote.nameToUUID "foo"
rs <- Logs.Remote.readRemoteLog
Just k <- Annex.WorkTree.lookupKey (toRawFilePath annexedfile)
return (fromJust $ M.lookup uuid rs, k)
let key = if scheme `elem` ["hybrid","pubkey"]
then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
else Nothing
testEncryptedRemote scheme key c [k] @? "invalid crypto setup"
annexed_present annexedfile
git_annex "drop" [annexedfile, "--numcopies=2"] "drop"
annexed_notpresent annexedfile
git_annex "move" [annexedfile, "--from", "foo"] "move --from encrypted remote"
annexed_present annexedfile
git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] "drop should not be allowed with numcopies=2"
annexed_present annexedfile
{- Ensure the configuration complies with the encryption scheme, and
- that all keys are encrypted properly for the given directory remote. -}
testEncryptedRemote scheme ks c keys = case Remote.Helper.Encryptable.extractCipher pc of
Just cip@Crypto.SharedCipher{} | scheme == "shared" && isNothing ks ->
checkKeys cip Nothing
Just cip@(Crypto.EncryptedCipher encipher v ks')
| checkScheme v && keysMatch ks' ->
checkKeys cip (Just v) <&&> checkCipher encipher ks'
_ -> return False
where
pc = either (const (Types.Remote.ParsedRemoteConfig mempty mempty)) id $
Remote.Helper.Encryptable.parseEncryptionConfig c
keysMatch (Utility.Gpg.KeyIds ks') =
maybe False (\(Utility.Gpg.KeyIds ks2) ->
sort (nub ks2) == sort (nub ks')) ks
checkCipher encipher = Utility.Gpg.checkEncryptionStream gpgcmd encipher . Just
checkScheme Types.Crypto.Hybrid = scheme == "hybrid"
checkScheme Types.Crypto.PubKey = scheme == "pubkey"
checkKeys cip mvariant = do
dummycfg <- Types.GitConfig.dummyRemoteGitConfig
let encparams = (Types.Remote.ParsedRemoteConfig mempty mempty, dummycfg)
cipher <- Crypto.decryptCipher gpgcmd encparams cip
files <- filterM doesFileExist $
map ("dir" </>) $ concatMap (serializeKeys cipher) keys
return (not $ null files) <&&> allM (checkFile mvariant) files
checkFile mvariant filename =
Utility.Gpg.checkEncryptionFile gpgcmd filename $
if mvariant == Just Types.Crypto.PubKey then ks else Nothing
serializeKeys cipher = map fromRawFilePath .
Annex.Locations.keyPaths .
Crypto.encryptKey Types.Crypto.HmacSha1 cipher
#else
test_crypto = putStrLn "gpg testing not implemented on Windows"
#endif
test_add_subdirs :: Assertion
test_add_subdirs = intmpclonerepo $ do
createDirectory "dir"
writecontent ("dir" </> "foo") $ "dir/" ++ content annexedfile
git_annex "add" ["dir"] "add of subdir"
{- Regression test for Windows bug where symlinks were not
- calculated correctly for files in subdirs. -}
unlessM (hasUnlockedFiles <$> getTestMode) $ do
git_annex "sync" [] "sync"
l <- annexeval $ Utility.FileSystemEncoding.decodeBL
<$> Annex.CatFile.catObject (Git.Types.Ref (encodeBS "HEAD:dir/foo"))
"../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l)
createDirectory "dir2"
writecontent ("dir2" </> "foo") $ content annexedfile
setCurrentDirectory "dir"
git_annex "add" [".." </> "dir2"] "add of ../subdir"
test_addurl :: Assertion
test_addurl = intmpclonerepo $ do
-- file:// only; this test suite should not hit the network
let filecmd c ps = git_annex c ("-cannex.security.allowed-url-schemes=file" : ps)
f <- fromRawFilePath <$> absPath (toRawFilePath "myurl")
let url = replace "\\" "/" ("file:///" ++ dropDrive f)
writecontent f "foo"
git_annex_shouldfail "addurl" [url] "addurl should not work on file url"
filecmd "addurl" [url] ("addurl on " ++ url)
let dest = "addurlurldest"
filecmd "addurl" ["--file", dest, url] ("addurl on " ++ url ++ " with --file")
doesFileExist dest @? (dest ++ " missing after addurl --file")
test_export_import :: Assertion
test_export_import = intmpclonerepo $ do
createDirectory "dir"
git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") "initremote"
git_annex "get" [] "get of files"
annexed_present annexedfile
-- Nothing to commit, but this makes sure the master branch
-- is in sync with the adjusted branch, which it may not be
-- depending on how the repository was set up.
commitchanges
origbranch <- annexeval origBranch
git_annex "export" [origbranch, "--to", "foo"] "export to dir"
dircontains annexedfile (content annexedfile)
writedir "import" (content "import")
git_annex "import" [origbranch, "--from", "foo"] "import from dir"
git_annex "merge" ["foo/" ++ origbranch] "git annex merge"
annexed_present_imported "import"
removeWhenExistsWith R.removeLink (toRawFilePath "import")
writecontent "import" (content "newimport1")
git_annex "add" ["import"] "add of import"
commitchanges
git_annex "export" [origbranch, "--to", "foo"] "export modified file to dir"
dircontains "import" (content "newimport1")
-- verify that export refuses to overwrite modified file
writedir "import" (content "newimport2")
removeWhenExistsWith R.removeLink (toRawFilePath "import")
writecontent "import" (content "newimport3")
git_annex "add" ["import"] "add of import"
commitchanges
git_annex_shouldfail "export" [origbranch, "--to", "foo"] "export should not work in conflict"
dircontains "import" (content "newimport2")
-- resolving import conflict
git_annex "import" [origbranch, "--from", "foo"] "import from dir"
git_shouldfail "merge" ["foo/master", "-mmerge"] "git merge of conflict should exit nonzero"
removeWhenExistsWith R.removeLink (toRawFilePath "import")
writecontent "import" (content "newimport3")
git_annex "add" ["import"] "add of import"
commitchanges
git_annex "export" [origbranch, "--to", "foo"] "export after import conflict"
dircontains "import" (content "newimport3")
where
dircontains f v =
((v==) <$> readFile ("dir" </> f))
@? ("did not find expected content of " ++ "dir" </> f)
writedir f = writecontent ("dir" </> f)
-- When on an adjusted branch, this updates the master branch
-- to match it, which is necessary since the master branch is going
-- to be exported.
commitchanges = git_annex "sync" ["--no-pull", "--no-push"] "sync"
test_export_import_subdir :: Assertion
test_export_import_subdir = intmpclonerepo $ do
createDirectory "dir"
git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") "initremote"
git_annex "get" [] "get of files"
annexed_present annexedfile
createDirectory subdir
git "mv" [annexedfile, subannexedfile] "git mv"
git "commit" ["-m", "moved"] "git commit"
-- When on an adjusted branch, this updates the master branch
-- to match it, which is necessary since the master branch is going
-- to be exported.
git_annex "sync" ["--no-pull", "--no-push"] "sync"
-- Run three times because there was a bug that took a couple
-- of runs to lead to the wrong tree being written to the remote
-- tracking branch.
testimport
testexport
testimport
testexport
testimport
testexport
where
dircontains f v =
((v==) <$> readFile ("dir" </> f))
@? ("did not find expected content of " ++ "dir" </> f)
subdir = "subdir"
subannexedfile = "subdir" </> annexedfile
testexport = do
origbranch <- annexeval origBranch
git_annex "export" [origbranch++":"++subdir, "--to", "foo"] "export of subdir"
dircontains annexedfile (content annexedfile)
testimport = do
origbranch <- annexeval origBranch
git_annex "import" [origbranch++":"++subdir, "--from", "foo"] "import of subdir"
git_annex "merge" ["foo/master"] "git annex merge foo/master"
-- Make sure that import did not import the file to the top
-- of the repo.
checkdoesnotexist annexedfile
|