git.iko.soy/project-m36
on master help sign in
Merge branch 'appveyor'
802f2ceAgentM
.appveyor.ymlnew file+36
compare with master
unifiedsplit
@@ -0,0 +1,36 @@
1+build: off
2+
3+version: 1.0.{build}-{branch}
4+
5+image: Visual Studio 2017
6+
7+before_test:
8+# http://help.appveyor.com/discussions/problems/6312-curl-command-not-found
9+- set PATH=C:\Program Files\Git\mingw64\bin;%PATH%
10+
11+- curl -sS -ostack.zip -L --insecure http://www.stackage.org/stack/windows-x86_64
12+- 7z x stack.zip stack.exe
13+
14+clone_folder: "c:\\project-m36"
15+clone_depth: 2
16+environment:
17+ global:
18+ STACK_ROOT: "c:\\sr"
19+
20+platform:
21+ - x64
22+
23+cache:
24+ - "c:\\sr"
25+ - "%LocalAppData%\\Programs\\stack"
26+
27+test_script:
28+ - stack setup > nul
29+# The ugly echo "" hack is to avoid complaints about 0 being an invalid file
30+# descriptor
31+ - echo "" | stack --no-terminal test
32+# - 7z.exe a -t7z -m0=lzma -mx=9 -mfb=64 -md=32m -ms=on project-m36.7z .stack-work\install\*\bin\project-m36-server.exe .stack-work\install\*\bin\project-m36-websocket-server.exe .stack-work\install\*\bin\tutd.exe .stack-work\install\*\bin\project-m36-server.exe
33+
34+#artifacts:
35+# - path: project-m36.7z
36+# name: project-m36.7z
README.markdown+2
@@ -5,6 +5,8 @@
5[![Hackage](https://img.shields.io/hackage/v/project-m36.svg)](http://hackage.haskell.org/package/project-m36)
5[![Hackage](https://img.shields.io/hackage/v/project-m36.svg)](http://hackage.haskell.org/package/project-m36)
6[![Hackage dependency status](https://img.shields.io/hackage-deps/v/project-m36.svg)](http://packdeps.haskellers.com/feed?needle=project-m36)
6[![Hackage dependency status](https://img.shields.io/hackage-deps/v/project-m36.svg)](http://packdeps.haskellers.com/feed?needle=project-m36)
7[![Build status](https://travis-ci.org/agentm/project-m36.svg?branch=master)](https://travis-ci.org/agentm/project-m36)
7[![Build status](https://travis-ci.org/agentm/project-m36.svg?branch=master)](https://travis-ci.org/agentm/project-m36)
8+[![Windows Build status](https://ci.appveyor.com/api/projects/status/q7jyddd6dy1ibqdo/branch/master?svg=true)
9+
8
10
9*Software can always be made faster, but rarely can it be made more correct.*
11*Software can always be made faster, but rarely can it be made more correct.*
10
12
src/lib/ProjectM36/FileLock.hs+2−10
@@ -48,22 +48,14 @@ lockFile winHandle lock = do
48
48
49 allocaBytes sizeof_OVERLAPPED $ \op -> do
49 allocaBytes sizeof_OVERLAPPED $ \op -> do
50 zeroMemory op $ fromIntegral sizeof_OVERLAPPED
50 zeroMemory op $ fromIntegral sizeof_OVERLAPPED
51− res <- c_lockFileEx winHandle (exFlag .|. blockFlag) 0 1 0 op
51+ failIfFalse_ "LockFileEx" $ c_lockFileEx winHandle (exFlag .|. blockFlag) 0 1 0 op
52− if res then
53− pure ()
54− else
55− error "failed to wait for database lock"
56
52
57unlockFile :: HANDLE -> IO ()
53unlockFile :: HANDLE -> IO ()
58unlockFile winHandle = do
54unlockFile winHandle = do
59 let sizeof_OVERLAPPED = 32
55 let sizeof_OVERLAPPED = 32
60 allocaBytes sizeof_OVERLAPPED $ \op -> do
56 allocaBytes sizeof_OVERLAPPED $ \op -> do
61 zeroMemory op $ fromIntegral sizeof_OVERLAPPED
57 zeroMemory op $ fromIntegral sizeof_OVERLAPPED
62− res <- c_unlockFileEx winHandle 0 1 0 op
58+ failIfFalse_ "UnlockFileEx" $ c_unlockFileEx winHandle 0 1 0 op
63− if res then
64− pure ()
65− else
66− error ("failed to unlock database lock: " ++ show res)
67
59
68#else
60#else
69--all of this complicated nonsense is fixed if we switch to GHC 8.2 which includes native flock support on handles
61--all of this complicated nonsense is fixed if we switch to GHC 8.2 which includes native flock support on handles
src/lib/ProjectM36/Persist.hs+2−1
@@ -79,12 +79,13 @@ syncHandle FsyncDiskSync handle =
79 --fdatasync doesn't exist on macOS
79 --fdatasync doesn't exist on macOS
80 fd <- handleToFd handle
80 fd <- handleToFd handle
81 fileSynchroniseDataOnly fd
81 fileSynchroniseDataOnly fd
82+ closeFd fd
82#else
83#else
83 do
84 do
84 fd <- handleToFd handle
85 fd <- handleToFd handle
85 fileSynchronise fd
86 fileSynchronise fd
86−#endif
87 closeFd fd
87 closeFd fd
88+#endif
88
89
89syncHandle NoDiskSync _ = pure ()
90syncHandle NoDiskSync _ = pure ()
90
91
src/lib/ProjectM36/ScriptSession.hs+2
@@ -48,6 +48,8 @@ initScriptSession ghcPkgPaths = do
48 "./dist-newstyle/packagedb/ghc-" ++ ghcVersion,
48 "./dist-newstyle/packagedb/ghc-" ++ ghcVersion,
49 ".cabal-sandbox/*ghc-" ++ ghcVersion ++ "-packages.conf.d",
49 ".cabal-sandbox/*ghc-" ++ ghcVersion ++ "-packages.conf.d",
50 ".stack-work/install/*/*/" ++ ghcVersion ++ "/pkgdb",
50 ".stack-work/install/*/*/" ++ ghcVersion ++ "/pkgdb",
51+ ".stack-work/install/*/pkgdb/", --windows stack build
52+ "C:/sr/snapshots/b201cfe6/pkgdb", --windows stack build- ideally, we could run `stack path --snapshot-pkg-db, but this is sufficient to pass CI
51 homeDir </> ".stack/snapshots/*/*/" ++ ghcVersion ++ "/pkgdb",
53 homeDir </> ".stack/snapshots/*/*/" ++ ghcVersion ++ "/pkgdb",
52 homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"
54 homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"
53 ]
55 ]
src/lib/ProjectM36/TransactionGraph.hs+1−1
@@ -508,7 +508,7 @@ backtrackGraph graph currentTid (TransactionIdHeadBranchBacktrack steps) = do
508backtrackGraph graph currentTid btrack@(TransactionStampHeadBacktrack stamp) = do
508backtrackGraph graph currentTid btrack@(TransactionStampHeadBacktrack stamp) = do
509 trans <- transactionForId currentTid graph
509 trans <- transactionForId currentTid graph
510 let parents = transactionParentIds trans
510 let parents = transactionParentIds trans
511− if transactionTimestamp trans < stamp then
511+ if transactionTimestamp trans <= stamp then
512 pure currentTid
512 pure currentTid
513 else if S.null parents then
513 else if S.null parents then
514 Left RootTransactionTraversalError
514 Left RootTransactionTraversalError