missed some __WINDOWS__ defines

This commit is contained in:
Joey Hess 2013-08-04 13:07:55 -04:00
parent a837ed47f7
commit 6a97896b47
7 changed files with 26 additions and 24 deletions

View file

@ -17,7 +17,7 @@ import qualified Control.Exception as E
import qualified Data.Map as M import qualified Data.Map as M
import Control.Exception (throw) import Control.Exception (throw)
import System.Console.GetOpt import System.Console.GetOpt
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
import System.Posix.Signals import System.Posix.Signals
#endif #endif
@ -123,7 +123,7 @@ tryRun' errnum state cmd (a:as) = do
{- Actions to perform each time ran. -} {- Actions to perform each time ran. -}
startup :: Annex Bool startup :: Annex Bool
startup = liftIO $ do startup = liftIO $ do
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
void $ installHandler sigINT Default Nothing void $ installHandler sigINT Default Nothing
#endif #endif
return True return True

View file

@ -107,7 +107,7 @@ getEnvCredPair storage = liftM2 (,)
{- Stores a CredPair in the environment. -} {- Stores a CredPair in the environment. -}
setEnvCredPair :: CredPair -> CredPairStorage -> IO () setEnvCredPair :: CredPair -> CredPairStorage -> IO ()
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
setEnvCredPair (l, p) storage = do setEnvCredPair (l, p) storage = do
set uenv l set uenv l
set penv p set penv p

4
Git.hs
View file

@ -32,7 +32,7 @@ module Git (
) where ) where
import Network.URI (uriPath, uriScheme, unEscapeString) import Network.URI (uriPath, uriScheme, unEscapeString)
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
import System.Posix.Files import System.Posix.Files
#endif #endif
@ -131,7 +131,7 @@ hookPath script repo = do
ifM (catchBoolIO $ isexecutable hook) ifM (catchBoolIO $ isexecutable hook)
( return $ Just hook , return Nothing ) ( return $ Just hook , return Nothing )
where where
#if __WINDOWS__ #if mingw32_HOST_OS
isexecutable f = doesFileExist f isexecutable f = doesFileExist f
#else #else
isexecutable f = isExecutable . fileMode <$> getFileStatus f isexecutable f = isExecutable . fileMode <$> getFileStatus f

View file

@ -23,7 +23,7 @@ import qualified Command.Get
import qualified Command.FromKey import qualified Command.FromKey
import qualified Command.DropKey import qualified Command.DropKey
import qualified Command.TransferKey import qualified Command.TransferKey
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
import qualified Command.TransferKeys import qualified Command.TransferKeys
#endif #endif
import qualified Command.ReKey import qualified Command.ReKey
@ -118,7 +118,7 @@ cmds = concat
, Command.FromKey.def , Command.FromKey.def
, Command.DropKey.def , Command.DropKey.def
, Command.TransferKey.def , Command.TransferKey.def
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
, Command.TransferKeys.def , Command.TransferKeys.def
#endif #endif
, Command.ReKey.def , Command.ReKey.def

12
Init.hs
View file

@ -26,21 +26,23 @@ import qualified Annex.Branch
import Logs.UUID import Logs.UUID
import Annex.Version import Annex.Version
import Annex.UUID import Annex.UUID
import Utility.UserInfo
import Utility.Shell import Utility.Shell
import Utility.FileMode
import Config import Config
import Annex.Direct import Annex.Direct
import Annex.Content.Direct import Annex.Content.Direct
import Annex.Environment import Annex.Environment
import Backend import Backend
#ifndef mingw32_HOST_OS
import Utility.UserInfo
import Utility.FileMode
#endif
genDescription :: Maybe String -> Annex String genDescription :: Maybe String -> Annex String
genDescription (Just d) = return d genDescription (Just d) = return d
genDescription Nothing = do genDescription Nothing = do
reldir <- liftIO . relHome =<< fromRepo Git.repoPath reldir <- liftIO . relHome =<< fromRepo Git.repoPath
hostname <- fromMaybe "" <$> liftIO getHostname hostname <- fromMaybe "" <$> liftIO getHostname
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
let at = if null hostname then "" else "@" let at = if null hostname then "" else "@"
username <- liftIO myUserName username <- liftIO myUserName
return $ concat [username, at, hostname, ":", reldir] return $ concat [username, at, hostname, ":", reldir]
@ -129,7 +131,7 @@ preCommitScript = unlines
- or removing write access from files. -} - or removing write access from files. -}
probeCrippledFileSystem :: Annex Bool probeCrippledFileSystem :: Annex Bool
probeCrippledFileSystem = do probeCrippledFileSystem = do
#ifdef __WINDOWS__ #ifdef mingw32_HOST_OS
return True return True
#else #else
tmp <- fromRepo gitAnnexTmpDir tmp <- fromRepo gitAnnexTmpDir
@ -177,7 +179,7 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do
probeFifoSupport :: Annex Bool probeFifoSupport :: Annex Bool
probeFifoSupport = do probeFifoSupport = do
#ifdef __WINDOWS__ #ifdef mingw32_HOST_OS
return False return False
#else #else
tmp <- fromRepo gitAnnexTmpDir tmp <- fromRepo gitAnnexTmpDir

20
Test.hs
View file

@ -58,7 +58,7 @@ import qualified Utility.Env
import qualified Utility.Gpg import qualified Utility.Gpg
import qualified Utility.Matcher import qualified Utility.Matcher
import qualified Utility.Exception import qualified Utility.Exception
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
import qualified GitAnnex import qualified GitAnnex
#endif #endif
@ -75,7 +75,7 @@ main = do
putStrLn " (Do not be alarmed by odd output here; it's normal." putStrLn " (Do not be alarmed by odd output here; it's normal."
putStrLn " wait for the last line to see how it went.)" putStrLn " wait for the last line to see how it went.)"
rs <- runhunit =<< prepare False rs <- runhunit =<< prepare False
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
directrs <- runhunit =<< prepare True directrs <- runhunit =<< prepare True
#else #else
-- Windows is only going to use direct mode, so don't test twice. -- Windows is only going to use direct mode, so don't test twice.
@ -221,7 +221,7 @@ test_add env = "git-annex add" ~: TestList [basic, sha1dup, subdirs]
git_annex env "add" ["dir"] @? "add of subdir failed" git_annex env "add" ["dir"] @? "add of subdir failed"
createDirectory "dir2" createDirectory "dir2"
writeFile ("dir2" </> "foo") $ content annexedfile writeFile ("dir2" </> "foo") $ content annexedfile
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
{- This does not work on Windows, for whatever reason. -} {- This does not work on Windows, for whatever reason. -}
setCurrentDirectory "dir" setCurrentDirectory "dir"
git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed" git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed"
@ -666,7 +666,7 @@ test_union_merge_regression env = "union merge regression" ~:
boolSystem "git" [Params "remote add r3", File ("../../" ++ r3)] @? "remote add" boolSystem "git" [Params "remote add r3", File ("../../" ++ r3)] @? "remote add"
git_annex env "get" [annexedfile] @? "get failed" git_annex env "get" [annexedfile] @? "get failed"
boolSystem "git" [Params "remote rm origin"] @? "remote rm" boolSystem "git" [Params "remote rm origin"] @? "remote rm"
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
forM_ [r3, r2, r1] $ \r -> indir env r $ forM_ [r3, r2, r1] $ \r -> indir env r $
git_annex env "sync" [] @? "sync failed" git_annex env "sync" [] @? "sync failed"
forM_ [r3, r2] $ \r -> indir env r $ forM_ [r3, r2] $ \r -> indir env r $
@ -707,7 +707,7 @@ test_conflict_resolution env = "automatic conflict resolution" ~:
git_annex env "unlock" [annexedfile] @? "unlock failed" git_annex env "unlock" [annexedfile] @? "unlock failed"
writeFile annexedfile newcontent writeFile annexedfile newcontent
) )
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
{- Sync twice in r1 so it gets the conflict resolution {- Sync twice in r1 so it gets the conflict resolution
- update from r2 -} - update from r2 -}
forM_ [r1, r2, r1] $ \r -> indir env r $ do forM_ [r1, r2, r1] $ \r -> indir env r $ do
@ -761,7 +761,7 @@ test_whereis env = "git-annex whereis" ~: intmpclonerepo env $ do
test_hook_remote :: TestEnv -> Test test_hook_remote :: TestEnv -> Test
test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed" git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed"
createDirectory dir createDirectory dir
git_config "annex.foo-store-hook" $ git_config "annex.foo-store-hook" $
@ -802,7 +802,7 @@ test_directory_remote env = "git-annex directory remote" ~: intmpclonerepo env $
annexed_present annexedfile annexed_present annexedfile
git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed" git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
annexed_notpresent annexedfile annexed_notpresent annexedfile
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
-- moving from directory special remote fails on Windows TODO -- moving from directory special remote fails on Windows TODO
git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed" git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed"
annexed_present annexedfile annexed_present annexedfile
@ -812,7 +812,7 @@ test_directory_remote env = "git-annex directory remote" ~: intmpclonerepo env $
test_rsync_remote :: TestEnv -> Test test_rsync_remote :: TestEnv -> Test
test_rsync_remote env = "git-annex rsync remote" ~: intmpclonerepo env $ do test_rsync_remote env = "git-annex rsync remote" ~: intmpclonerepo env $ do
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
createDirectory "dir" createDirectory "dir"
git_annex env "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed" git_annex env "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"
git_annex env "get" [annexedfile] @? "get of file failed" git_annex env "get" [annexedfile] @? "get of file failed"
@ -849,7 +849,7 @@ test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build.
-- gpg is not a build dependency, so only test when it's available -- gpg is not a build dependency, so only test when it's available
test_crypto :: TestEnv -> Test test_crypto :: TestEnv -> Test
test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
Utility.Gpg.testTestHarness @? "test harness self-test failed" Utility.Gpg.testTestHarness @? "test harness self-test failed"
Utility.Gpg.testHarness $ do Utility.Gpg.testHarness $ do
createDirectory "dir" createDirectory "dir"
@ -882,7 +882,7 @@ test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path
-- (when the OS allows) so test coverage collection works. -- (when the OS allows) so test coverage collection works.
git_annex :: TestEnv -> String -> [String] -> IO Bool git_annex :: TestEnv -> String -> [String] -> IO Bool
git_annex env command params = do git_annex env command params = do
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
forM_ (M.toList env) $ \(var, val) -> forM_ (M.toList env) $ \(var, val) ->
Utility.Env.setEnv var val True Utility.Env.setEnv var val True

View file

@ -11,7 +11,7 @@ module Upgrade where
import Common.Annex import Common.Annex
import Annex.Version import Annex.Version
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
import qualified Upgrade.V0 import qualified Upgrade.V0
import qualified Upgrade.V1 import qualified Upgrade.V1
#endif #endif
@ -20,7 +20,7 @@ import qualified Upgrade.V2
upgrade :: Annex Bool upgrade :: Annex Bool
upgrade = go =<< getVersion upgrade = go =<< getVersion
where where
#ifndef __WINDOWS__ #ifndef mingw32_HOST_OS
go (Just "0") = Upgrade.V0.upgrade go (Just "0") = Upgrade.V0.upgrade
go (Just "1") = Upgrade.V1.upgrade go (Just "1") = Upgrade.V1.upgrade
#else #else