diff options
author | Joey Hess <joey@kitenet.net> | 2012-08-05 15:14:21 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-08-05 15:18:56 -0400 |
commit | 7478872a095ef9b05ce9124f9b1f5be2773065a8 (patch) | |
tree | ffbd604fcc2d75795e9a2ebde6bcbea24c4389a9 /Assistant/ScanRemotes.hs | |
parent | ac71ab7bd7dded89202fde4a1f725dac32c7cd3c (diff) |
fix crash when just one remote needs to be scanned
The TMVar is supposed to be left empty once the map is empty, but the code
neglected to do that, so the next time takeMVar got an empty map, which
is not handled since that was supposed to never happen..
Also, avoid any possibility of this crash. If an empty map somehow creeps
in, just retry.
Diffstat (limited to 'Assistant/ScanRemotes.hs')
-rw-r--r-- | Assistant/ScanRemotes.hs | 12 |
1 files changed, 8 insertions, 4 deletions
diff --git a/Assistant/ScanRemotes.hs b/Assistant/ScanRemotes.hs index 05b2a2ca9..2362bd9b4 100644 --- a/Assistant/ScanRemotes.hs +++ b/Assistant/ScanRemotes.hs @@ -26,10 +26,14 @@ newScanRemoteMap = atomically newEmptyTMVar getScanRemote :: ScanRemoteMap -> IO Remote getScanRemote v = atomically $ do m <- takeTMVar v - let newest = Prelude.head $ reverse $ - map fst $ sortBy (compare `on` snd) $ M.toList m - putTMVar v $ M.delete newest m - return newest + let l = reverse $ map fst $ sortBy (compare `on` snd) $ M.toList m + case l of + [] -> retry -- should never happen + (newest:_) -> do + let m' = M.delete newest m + unless (M.null m') $ + putTMVar v m' + return newest {- Adds new remotes that need scanning to the map. -} addScanRemotes :: ScanRemoteMap -> [Remote] -> IO () |