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