Commit fbb95f28 authored by Iustin Pop's avatar Iustin Pop
Browse files

Turn on, and fix, more warnings

The Makefile was intented to be -Wall and not simply -W, but I missed
that. This enables more warnings and also enables -Werror (except for
the tests).
parent 685f5bc6
...@@ -431,10 +431,10 @@ checkMove nodes_idx disk_moves ini_tbl victims = ...@@ -431,10 +431,10 @@ checkMove nodes_idx disk_moves ini_tbl victims =
-- iterate over all instances, computing the best move -- iterate over all instances, computing the best move
best_tbl = best_tbl =
foldl' foldl'
(\ step_tbl elem -> (\ step_tbl em ->
if Instance.snode elem == Node.noSecondary then step_tbl if Instance.snode em == Node.noSecondary then step_tbl
else compareTables step_tbl $ else compareTables step_tbl $
checkInstanceMove nodes_idx disk_moves ini_tbl elem) checkInstanceMove nodes_idx disk_moves ini_tbl em)
ini_tbl victims ini_tbl victims
Table _ _ _ best_plc = best_tbl Table _ _ _ best_plc = best_tbl
in in
...@@ -478,9 +478,9 @@ collapseFailures flst = ...@@ -478,9 +478,9 @@ collapseFailures flst =
-- | Update current Allocation solution and failure stats with new -- | Update current Allocation solution and failure stats with new
-- elements -- elements
concatAllocs :: AllocSolution -> OpResult AllocElement -> AllocSolution concatAllocs :: AllocSolution -> OpResult AllocElement -> AllocSolution
concatAllocs (flst, succ, sols) (OpFail reason) = (reason:flst, succ, sols) concatAllocs (flst, cntok, sols) (OpFail reason) = (reason:flst, cntok, sols)
concatAllocs (flst, succ, osols) (OpGood ns@(nl, _, _)) = concatAllocs (flst, cntok, osols) (OpGood ns@(nl, _, _)) =
let nscore = compCV nl let nscore = compCV nl
-- Choose the old or new solution, based on the cluster score -- Choose the old or new solution, based on the cluster score
nsols = case osols of nsols = case osols of
...@@ -489,7 +489,7 @@ concatAllocs (flst, succ, osols) (OpGood ns@(nl, _, _)) = ...@@ -489,7 +489,7 @@ concatAllocs (flst, succ, osols) (OpGood ns@(nl, _, _)) =
if oscore < nscore if oscore < nscore
then osols then osols
else Just (nscore, ns) else Just (nscore, ns)
nsuc = succ + 1 nsuc = cntok + 1
-- Note: we force evaluation of nsols here in order to keep the -- Note: we force evaluation of nsols here in order to keep the
-- memory profile low - we know that we will need nsols for sure -- memory profile low - we know that we will need nsols for sure
-- in the next cycle, so we force evaluation of nsols, since the -- in the next cycle, so we force evaluation of nsols, since the
...@@ -539,11 +539,11 @@ tryReloc nl il xid 1 ex_idx = ...@@ -539,11 +539,11 @@ tryReloc nl il xid 1 ex_idx =
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
valid_idxes = map Node.idx valid_nodes valid_idxes = map Node.idx valid_nodes
sols1 = foldl' (\cstate x -> sols1 = foldl' (\cstate x ->
let elem = do let em = do
(mnl, i, _, _) <- (mnl, i, _, _) <-
applyMove nl inst (ReplaceSecondary x) applyMove nl inst (ReplaceSecondary x)
return (mnl, i, [Container.find x mnl]) return (mnl, i, [Container.find x mnl])
in concatAllocs cstate elem in concatAllocs cstate em
) ([], 0, Nothing) valid_idxes ) ([], 0, Nothing) valid_idxes
in return sols1 in return sols1
......
...@@ -133,10 +133,10 @@ recvMsg s = do ...@@ -133,10 +133,10 @@ recvMsg s = do
let _recv obuf = do let _recv obuf = do
nbuf <- withTimeout queryTimeout "reading luxi response" $ nbuf <- withTimeout queryTimeout "reading luxi response" $
S.recv (socket s) 4096 S.recv (socket s) 4096
let (msg, rbuf) = break ((==) eOM) (obuf ++ nbuf) let (msg, remaining) = break ((==) eOM) (obuf ++ nbuf)
(if null rbuf (if null remaining
then _recv msg then _recv msg
else return (msg, drop 1 rbuf)) else return (msg, tail remaining))
cbuf <- readIORef $ rbuf s cbuf <- readIORef $ rbuf s
(msg, nbuf) <- _recv cbuf (msg, nbuf) <- _recv cbuf
writeIORef (rbuf s) nbuf writeIORef (rbuf s) nbuf
......
...@@ -217,11 +217,11 @@ buildPeers t il = ...@@ -217,11 +217,11 @@ buildPeers t il =
-- | Assigns an instance to a node as primary without other updates. -- | Assigns an instance to a node as primary without other updates.
setPri :: Node -> T.Idx -> Node setPri :: Node -> T.Idx -> Node
setPri t idx = t { plist = idx:plist t } setPri t ix = t { plist = ix:plist t }
-- | Assigns an instance to a node as secondary without other updates. -- | Assigns an instance to a node as secondary without other updates.
setSec :: Node -> T.Idx -> Node setSec :: Node -> T.Idx -> Node
setSec t idx = t { slist = idx:slist t } setSec t ix = t { slist = ix:slist t }
-- | Add primary cpus to a node -- | Add primary cpus to a node
addCpus :: Node -> Int -> Node addCpus :: Node -> Int -> Node
......
...@@ -88,11 +88,11 @@ instance Arbitrary Node.Node where ...@@ -88,11 +88,11 @@ instance Arbitrary Node.Node where
return n' return n'
-- | Make sure add is idempotent -- | Make sure add is idempotent
prop_PeerMap_addIdempotent pmap key elem = prop_PeerMap_addIdempotent pmap key em =
fn puniq == fn (fn puniq) fn puniq == fn (fn puniq)
where _types = (pmap::PeerMap.PeerMap, where _types = (pmap::PeerMap.PeerMap,
key::PeerMap.Key, elem::PeerMap.Elem) key::PeerMap.Key, em::PeerMap.Elem)
fn = PeerMap.add key elem fn = PeerMap.add key em
puniq = PeerMap.accumArray const pmap puniq = PeerMap.accumArray const pmap
-- | Make sure remove is idempotent -- | Make sure remove is idempotent
...@@ -109,10 +109,10 @@ prop_PeerMap_findMissing pmap key = ...@@ -109,10 +109,10 @@ prop_PeerMap_findMissing pmap key =
puniq = PeerMap.accumArray const pmap puniq = PeerMap.accumArray const pmap
-- | Make sure an added item is found -- | Make sure an added item is found
prop_PeerMap_addFind pmap key elem = prop_PeerMap_addFind pmap key em =
PeerMap.find key (PeerMap.add key elem puniq) == elem PeerMap.find key (PeerMap.add key em puniq) == em
where _types = (pmap::PeerMap.PeerMap, where _types = (pmap::PeerMap.PeerMap,
key::PeerMap.Key, elem::PeerMap.Elem) key::PeerMap.Key, em::PeerMap.Elem)
puniq = PeerMap.accumArray const pmap puniq = PeerMap.accumArray const pmap
-- | Manual check that maxElem returns the maximum indeed, or 0 for null -- | Manual check that maxElem returns the maximum indeed, or 0 for null
......
...@@ -81,7 +81,7 @@ meanValue lst = sum lst / fromIntegral (length lst) ...@@ -81,7 +81,7 @@ meanValue lst = sum lst / fromIntegral (length lst)
stdDev :: Floating a => [a] -> a stdDev :: Floating a => [a] -> a
stdDev lst = stdDev lst =
let mv = meanValue lst let mv = meanValue lst
av = foldl' (\accu elem -> let d = elem - mv in accu + d * d) 0.0 lst av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst
bv = sqrt (av / fromIntegral (length lst)) bv = sqrt (av / fromIntegral (length lst))
in bv in bv
......
...@@ -5,7 +5,7 @@ HDDIR = apidoc ...@@ -5,7 +5,7 @@ HDDIR = apidoc
DOCS = README.html NEWS.html DOCS = README.html NEWS.html
HFLAGS = -O2 -W -fwarn-monomorphism-restriction -fwarn-tabs HFLAGS = -O2 -Wall -Werror -fwarn-monomorphism-restriction -fwarn-tabs
HEXTRA = HEXTRA =
HPCEXCL = --exclude Main --exclude Ganeti.HTools.QC HPCEXCL = --exclude Main --exclude Ganeti.HTools.QC
...@@ -17,7 +17,7 @@ all: $(HPROGS) ...@@ -17,7 +17,7 @@ all: $(HPROGS)
$(HALLPROGS): %: %.hs Ganeti/HTools/Version.hs $(HSRCS) Makefile $(HALLPROGS): %: %.hs Ganeti/HTools/Version.hs $(HSRCS) Makefile
ghc --make $(HFLAGS) $(HEXTRA) $@ ghc --make $(HFLAGS) $(HEXTRA) $@
test: HEXTRA=-fhpc test: HEXTRA=-fhpc -Wwarn
$(DOCS) : %.html : % $(DOCS) : %.html : %
rst2html $< $@ rst2html $< $@
......
...@@ -47,14 +47,14 @@ options :: [OptType] ...@@ -47,14 +47,14 @@ options :: [OptType]
options = [oShowVer, oShowHelp] options = [oShowVer, oShowHelp]
processResults :: (Monad m) => Cluster.AllocSolution -> m (String, [Node.Node]) processResults :: (Monad m) => Cluster.AllocSolution -> m (String, [Node.Node])
processResults (fstats, succ, sols) = processResults (fstats, successes, sols) =
case sols of case sols of
Nothing -> fail "No valid allocation solutions" Nothing -> fail "No valid allocation solutions"
Just (best, (_, _, w)) -> Just (best, (_, _, w)) ->
let tfails = length fstats let tfails = length fstats
info = printf "successes %d, failures %d,\ info = printf "successes %d, failures %d,\
\ best score: %.8f for node(s) %s" \ best score: %.8f for node(s) %s"
succ tfails successes tfails
best (intercalate "/" . map Node.name $ w)::String best (intercalate "/" . map Node.name $ w)::String
in return (info, w) in return (info, w)
...@@ -90,8 +90,8 @@ main = do ...@@ -90,8 +90,8 @@ main = do
sols = processRequest request >>= processResults sols = processRequest request >>= processResults
let (ok, info, rn) = let (ok, info, rn) =
case sols of case sols of
Ok (info, sn) -> (True, "Request successful: " ++ info, Ok (ginfo, sn) -> (True, "Request successful: " ++ ginfo,
map ((++ csf) . Node.name) sn) map ((++ csf) . Node.name) sn)
Bad s -> (False, "Request failed: " ++ s, []) Bad s -> (False, "Request failed: " ++ s, [])
resp = formatResponse ok info rn resp = formatResponse ok info rn
putStrLn resp putStrLn resp
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment