Commit 72747d91 authored by Iustin Pop's avatar Iustin Pop
Browse files

Remove use of 'head' and add hlint warning for it



Since 'head' is unsafe to use in most cases, this patch removes its
use from most of the code, adds a lint warning for it (and for tail as
well), and adds override annotations in the few cases where it's
actually OK to use it (mainly when using head over the result of
functions which guarantee to return a non-empty list by documentation,
not type).
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarHelga Velroyen <helgav@google.com>
parent b6ad806f
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -82,14 +82,14 @@ parseInstance :: NameAssoc -- ^ The node name-to-index association list ...@@ -82,14 +82,14 @@ parseInstance :: NameAssoc -- ^ The node name-to-index association list
parseInstance ktn n a = do parseInstance ktn n a = do
base <- parseBaseInstance n a base <- parseBaseInstance n a
nodes <- fromObj a "nodes" nodes <- fromObj a "nodes"
pnode <- if null nodes (pnode, snodes) <-
then Bad $ "empty node list for instance " ++ n case nodes of
else readEitherString $ head nodes [] -> Bad $ "empty node list for instance " ++ n
x:xs -> readEitherString x >>= \x' -> return (x', xs)
pidx <- lookupNode ktn n pnode pidx <- lookupNode ktn n pnode
let snodes = tail nodes sidx <- case snodes of
sidx <- if null snodes [] -> return Node.noSecondary
then return Node.noSecondary x:_ -> readEitherString x >>= lookupNode ktn n
else readEitherString (head snodes) >>= lookupNode ktn n
return (n, Instance.setBoth (snd base) pidx sidx) return (n, Instance.setBoth (snd base) pidx sidx)
-- | Parses a node as found in the cluster node list. -- | Parses a node as found in the cluster node list.
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -163,10 +163,10 @@ parseInstance ktn [ name, disk, mem, vcpus ...@@ -163,10 +163,10 @@ parseInstance ktn [ name, disk, mem, vcpus
_ -> convert "be/memory" mem _ -> convert "be/memory" mem
xvcpus <- convert "be/vcpus" vcpus xvcpus <- convert "be/vcpus" vcpus
xpnode <- convert "pnode" pnode >>= lookupNode ktn xname xpnode <- convert "pnode" pnode >>= lookupNode ktn xname
xsnodes <- convert "snodes" snodes::Result [JSString] xsnodes <- convert "snodes" snodes::Result [String]
snode <- if null xsnodes snode <- case xsnodes of
then return Node.noSecondary [] -> return Node.noSecondary
else lookupNode ktn xname (fromJSString $ head xsnodes) x:_ -> lookupNode ktn xname x
xrunning <- convert "status" status xrunning <- convert "status" status
xtags <- convert "tags" tags xtags <- convert "tags" tags
xauto_balance <- convert "auto_balance" auto_balance xauto_balance <- convert "auto_balance" auto_balance
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -138,9 +138,9 @@ parseInstance ktn a = do ...@@ -138,9 +138,9 @@ parseInstance ktn a = do
vcpus <- extract "vcpus" beparams vcpus <- extract "vcpus" beparams
pnode <- extract "pnode" a >>= lookupNode ktn name pnode <- extract "pnode" a >>= lookupNode ktn name
snodes <- extract "snodes" a snodes <- extract "snodes" a
snode <- if null snodes snode <- case snodes of
then return Node.noSecondary [] -> return Node.noSecondary
else readEitherString (head snodes) >>= lookupNode ktn name x:_ -> readEitherString x >>= lookupNode ktn name
running <- extract "status" a running <- extract "status" a
tags <- extract "tags" a tags <- extract "tags" a
auto_balance <- extract "auto_balance" beparams auto_balance <- extract "auto_balance" beparams
......
...@@ -829,14 +829,13 @@ findBestAllocGroup mggl mgnl mgil allowed_gdxs inst cnt = ...@@ -829,14 +829,13 @@ findBestAllocGroup mggl mgnl mgil allowed_gdxs inst cnt =
all_msgs = concatMap (solutionDescription mggl) sols all_msgs = concatMap (solutionDescription mggl) sols
goodSols = filterMGResults mggl sols goodSols = filterMGResults mggl sols
sortedSols = sortMGResults mggl goodSols sortedSols = sortMGResults mggl goodSols
in if null sortedSols in case sortedSols of
then Bad $ if null groups' [] -> Bad $ if null groups'
then "no groups for evacuation: allowed groups was" ++ then "no groups for evacuation: allowed groups was" ++
show allowed_gdxs ++ ", all groups: " ++ show allowed_gdxs ++ ", all groups: " ++
show (map fst groups) show (map fst groups)
else intercalate ", " all_msgs else intercalate ", " all_msgs
else let (final_group, final_sol) = head sortedSols (final_group, final_sol):_ -> return (final_group, final_sol, all_msgs)
in return (final_group, final_sol, all_msgs)
-- | Try to allocate an instance on a multi-group cluster. -- | Try to allocate an instance on a multi-group cluster.
tryMGAlloc :: Group.List -- ^ The group list tryMGAlloc :: Group.List -- ^ The group list
......
...@@ -28,7 +28,7 @@ University Clausthal, 1-9. ...@@ -28,7 +28,7 @@ University Clausthal, 1-9.
{- {-
Copyright (C) 2012, Google Inc. Copyright (C) 2012, 2013, Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -147,6 +147,7 @@ verticesColorSet cMap = IntSet.fromList . verticesColors cMap ...@@ -147,6 +147,7 @@ verticesColorSet cMap = IntSet.fromList . verticesColors cMap
neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color] neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color]
neighColors g cMap v = verticesColors cMap $ neighbors g v neighColors g cMap v = verticesColors cMap $ neighbors g v
{-# ANN colorNode "HLint: ignore Use alternative" #-}
-- | Color one node. -- | Color one node.
colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color
-- use of "head" is A-ok as the source is an infinite list -- use of "head" is A-ok as the source is an infinite list
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -679,10 +679,13 @@ defaultFields = ...@@ -679,10 +679,13 @@ defaultFields =
, "pfmem", "pfdsk", "rcpu" , "pfmem", "pfdsk", "rcpu"
, "cload", "mload", "dload", "nload" ] , "cload", "mload", "dload", "nload" ]
{-# ANN computeGroups "HLint: ignore Use alternative" #-}
-- | Split a list of nodes into a list of (node group UUID, list of -- | Split a list of nodes into a list of (node group UUID, list of
-- associated nodes). -- associated nodes).
computeGroups :: [Node] -> [(T.Gdx, [Node])] computeGroups :: [Node] -> [(T.Gdx, [Node])]
computeGroups nodes = computeGroups nodes =
let nodes' = sortBy (comparing group) nodes let nodes' = sortBy (comparing group) nodes
nodes'' = groupBy ((==) `on` group) nodes' nodes'' = groupBy ((==) `on` group) nodes'
-- use of head here is OK, since groupBy returns non-empty lists; if
-- you remove groupBy, also remove use of head
in map (\nl -> (group (head nl), nl)) nodes'' in map (\nl -> (group (head nl), nl)) nodes''
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -59,9 +59,11 @@ arguments = [ArgCompletion OptComplFile 1 (Just 1)] ...@@ -59,9 +59,11 @@ arguments = [ArgCompletion OptComplFile 1 (Just 1)]
wrapReadRequest :: Options -> [String] -> IO Request wrapReadRequest :: Options -> [String] -> IO Request
wrapReadRequest opts args = do wrapReadRequest opts args = do
when (null args) $ exitErr "This program needs an input file." r1 <- case args of
[] -> exitErr "This program needs an input file."
_:_:_ -> exitErr "Only one argument is accepted (the input file)"
x:_ -> readRequest x
r1 <- readRequest (head args)
if isJust (optDataFile opts) || (not . null . optNodeSim) opts if isJust (optDataFile opts) || (not . null . optNodeSim) opts
then do then do
cdata <- loadExternalData opts cdata <- loadExternalData opts
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -135,8 +135,9 @@ iterateDepth printmove ini_tbl max_rounds disk_moves inst_moves nmlen imlen ...@@ -135,8 +135,9 @@ iterateDepth printmove ini_tbl max_rounds disk_moves inst_moves nmlen imlen
Just fin_tbl -> Just fin_tbl ->
do do
let (Cluster.Table _ _ _ fin_plc) = fin_tbl let (Cluster.Table _ _ _ fin_plc) = fin_tbl
fin_plc_len = length fin_plc cur_plc@(idx, _, _, move, _) <-
cur_plc@(idx, _, _, move, _) = head fin_plc exitIfEmpty "Empty placement list returned for solution?!" fin_plc
let fin_plc_len = length fin_plc
(sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il
nmlen imlen cur_plc fin_plc_len nmlen imlen cur_plc fin_plc_len
afn = Cluster.involvedNodes ini_il cur_plc afn = Cluster.involvedNodes ini_il cur_plc
...@@ -261,8 +262,8 @@ selectGroup opts gl nlf ilf = do ...@@ -261,8 +262,8 @@ selectGroup opts gl nlf ilf = do
case optGroup opts of case optGroup opts of
Nothing -> do Nothing -> do
let (gidx, cdata) = head ngroups (gidx, cdata) <- exitIfEmpty "No groups found by splitCluster?!" ngroups
grp = Container.find gidx gl let grp = Container.find gidx gl
return (Group.name grp, cdata) return (Group.name grp, cdata)
Just g -> case Container.findByName gl g of Just g -> case Container.findByName gl g of
Nothing -> do Nothing -> do
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -105,6 +105,11 @@ specDescription :: SpecType -> String ...@@ -105,6 +105,11 @@ specDescription :: SpecType -> String
specDescription SpecNormal = "Standard (fixed-size)" specDescription SpecNormal = "Standard (fixed-size)"
specDescription SpecTiered = "Tiered (initial size)" specDescription SpecTiered = "Tiered (initial size)"
-- | The \"name\" of a 'SpecType'.
specName :: SpecType -> String
specName SpecNormal = "Standard"
specName SpecTiered = "Tiered"
-- | Efficiency generic function. -- | Efficiency generic function.
effFn :: (Cluster.CStats -> Integer) effFn :: (Cluster.CStats -> Integer)
-> (Cluster.CStats -> Double) -> (Cluster.CStats -> Double)
...@@ -191,12 +196,14 @@ printResults True _ fin_nl num_instances allocs sreason = do ...@@ -191,12 +196,14 @@ printResults True _ fin_nl num_instances allocs sreason = do
\ != counted (%d)\n" (num_instances + allocs) \ != counted (%d)\n" (num_instances + allocs)
(Cluster.csNinst fin_stats) (Cluster.csNinst fin_stats)
main_reason <- exitIfEmpty "Internal error, no failure reasons?!" sreason
printKeysHTS $ printStats PFinal fin_stats printKeysHTS $ printStats PFinal fin_stats
printKeysHTS [ ("ALLOC_USAGE", printf "%.8f" printKeysHTS [ ("ALLOC_USAGE", printf "%.8f"
((fromIntegral num_instances::Double) / ((fromIntegral num_instances::Double) /
fromIntegral fin_instances)) fromIntegral fin_instances))
, ("ALLOC_INSTANCES", printf "%d" allocs) , ("ALLOC_INSTANCES", printf "%d" allocs)
, ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason) , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ main_reason)
] ]
printKeysHTS $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x), printKeysHTS $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
printf "%d" y)) sreason printf "%d" y)) sreason
...@@ -210,6 +217,7 @@ printResults False ini_nl fin_nl _ allocs sreason = do ...@@ -210,6 +217,7 @@ printResults False ini_nl fin_nl _ allocs sreason = do
printFinalHTS :: Bool -> IO () printFinalHTS :: Bool -> IO ()
printFinalHTS = printFinal htsPrefix printFinalHTS = printFinal htsPrefix
{-# ANN tieredSpecMap "HLint: ignore Use alternative" #-}
-- | Compute the tiered spec counts from a list of allocated -- | Compute the tiered spec counts from a list of allocated
-- instances. -- instances.
tieredSpecMap :: [Instance.Instance] tieredSpecMap :: [Instance.Instance]
...@@ -217,6 +225,7 @@ tieredSpecMap :: [Instance.Instance] ...@@ -217,6 +225,7 @@ tieredSpecMap :: [Instance.Instance]
tieredSpecMap trl_ixes = tieredSpecMap trl_ixes =
let fin_trl_ixes = reverse trl_ixes let fin_trl_ixes = reverse trl_ixes
ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
-- head is "safe" here, as groupBy returns list of non-empty lists
spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs)) spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
ix_byspec ix_byspec
in spec_map in spec_map
...@@ -365,7 +374,7 @@ runAllocation cdata stop_allocation actual_result spec dt mode opts = do ...@@ -365,7 +374,7 @@ runAllocation cdata stop_allocation actual_result spec dt mode opts = do
Just result_noalloc -> return result_noalloc Just result_noalloc -> return result_noalloc
Nothing -> exitIfBad "failure during allocation" actual_result Nothing -> exitIfBad "failure during allocation" actual_result
let name = head . words . specDescription $ mode let name = specName mode
descr = name ++ " allocation" descr = name ++ " allocation"
ldescr = "after " ++ map toLower descr ldescr = "after " ++ map toLower descr
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
{- {-
Copyright (C) 2012 Google Inc. Copyright (C) 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -87,6 +87,9 @@ handleCall :: ConfigData -> LuxiOp -> IO (ErrorResult JSValue) ...@@ -87,6 +87,9 @@ handleCall :: ConfigData -> LuxiOp -> IO (ErrorResult JSValue)
handleCall cdata QueryClusterInfo = handleCall cdata QueryClusterInfo =
let cluster = configCluster cdata let cluster = configCluster cdata
hypervisors = clusterEnabledHypervisors cluster hypervisors = clusterEnabledHypervisors cluster
def_hv = case hypervisors of
x:_ -> showJSON x
[] -> JSNull
bits = show (bitSize (0::Int)) ++ "bits" bits = show (bitSize (0::Int)) ++ "bits"
arch_tuple = [bits, arch] arch_tuple = [bits, arch]
obj = [ ("software_version", showJSON C.releaseVersion) obj = [ ("software_version", showJSON C.releaseVersion)
...@@ -97,7 +100,7 @@ handleCall cdata QueryClusterInfo = ...@@ -97,7 +100,7 @@ handleCall cdata QueryClusterInfo =
, ("architecture", showJSON arch_tuple) , ("architecture", showJSON arch_tuple)
, ("name", showJSON $ clusterClusterName cluster) , ("name", showJSON $ clusterClusterName cluster)
, ("master", showJSON $ clusterMasterNode cluster) , ("master", showJSON $ clusterMasterNode cluster)
, ("default_hypervisor", showJSON $ head hypervisors) , ("default_hypervisor", def_hv)
, ("enabled_hypervisors", showJSON hypervisors) , ("enabled_hypervisors", showJSON hypervisors)
, ("hvparams", showJSON $ clusterHvparams cluster) , ("hvparams", showJSON $ clusterHvparams cluster)
, ("os_hvp", showJSON $ clusterOsHvp cluster) , ("os_hvp", showJSON $ clusterOsHvp cluster)
......
...@@ -51,6 +51,8 @@ module Ganeti.Utils ...@@ -51,6 +51,8 @@ module Ganeti.Utils
, chompPrefix , chompPrefix
, wrap , wrap
, trim , trim
, defaultHead
, exitIfEmpty
) where ) where
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace) import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)
...@@ -369,3 +371,14 @@ wrap maxWidth = filter (not . null) . map trim . wrap0 ...@@ -369,3 +371,14 @@ wrap maxWidth = filter (not . null) . map trim . wrap0
-- strings. -- strings.
trim :: String -> String trim :: String -> String
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
-- | A safer head version, with a default value.
defaultHead :: a -> [a] -> a
defaultHead def [] = def
defaultHead _ (x:_) = x
-- | A 'head' version in the I/O monad, for validating parameters
-- without which we cannot continue.
exitIfEmpty :: String -> [a] -> IO a
exitIfEmpty _ (x:_) = return x
exitIfEmpty s [] = exitErr s
...@@ -20,3 +20,9 @@ warn = map (\v -> (x, v)) ==> zip (repeat x) ...@@ -20,3 +20,9 @@ warn = map (\v -> (x, v)) ==> zip (repeat x)
warn = length x > 0 ==> not (null x) warn = length x > 0 ==> not (null x)
warn = length x /= 0 ==> not (null x) warn = length x /= 0 ==> not (null x)
warn = length x == 0 ==> null x warn = length x == 0 ==> null x
-- Never use head, use 'case' which covers all possibilities
warn = head x ==> case x of { y:_ -> y } where note = "Head is unsafe, please use case and handle the empty list as well"
-- Never use tail, use 'case' which covers all possibilities
warn = tail x ==> case x of { _:y -> y } where note = "Tail is unsafe, please use case and handle the empty list as well"
...@@ -83,7 +83,10 @@ passFailOpt :: (StandardOptions b) => ...@@ -83,7 +83,10 @@ passFailOpt :: (StandardOptions b) =>
-> c -> c
passFailOpt defaults failfn passfn passFailOpt defaults failfn passfn
(opt@(GetOpt.Option _ longs _ _, _), bad, good) = (opt@(GetOpt.Option _ longs _ _, _), bad, good) =
let prefix = "--" ++ head longs ++ "=" let first_opt = case longs of
[] -> error "no long options?"
x:_ -> x
prefix = "--" ++ first_opt ++ "="
good_cmd = prefix ++ good good_cmd = prefix ++ good
bad_cmd = prefix ++ bad in bad_cmd = prefix ++ bad in
case (parseOptsInner defaults [bad_cmd] "prog" [opt] [], case (parseOptsInner defaults [bad_cmd] "prog" [opt] [],
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -52,8 +52,10 @@ prop_addTwo cdata i1 i2 = ...@@ -52,8 +52,10 @@ prop_addTwo cdata i1 i2 =
prop_nameOf :: Node.Node -> Property prop_nameOf :: Node.Node -> Property
prop_nameOf node = prop_nameOf node =
let nl = makeSmallCluster node 1 let nl = makeSmallCluster node 1
fnode = head (Container.elems nl) in case Container.elems nl of
in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode [] -> failTest "makeSmallCluster 1 returned empty cluster?"
_:_:_ -> failTest "makeSmallCluster 1 returned >1 node?"
fnode:_ -> Container.nameOf nl (Node.idx fnode) ==? Node.name fnode
-- | We test that in a cluster, given a random node, we can find it by -- | We test that in a cluster, given a random node, we can find it by
-- its name and alias, as long as all names and aliases are unique, -- its name and alias, as long as all names and aliases are unique,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
{- {-
Copyright (C) 2012 Google Inc. Copyright (C) 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -135,14 +135,12 @@ prop_JobStatus = ...@@ -135,14 +135,12 @@ prop_JobStatus =
case_JobStatusPri_py_equiv :: Assertion case_JobStatusPri_py_equiv :: Assertion
case_JobStatusPri_py_equiv = do case_JobStatusPri_py_equiv = do
let num_jobs = 2000::Int let num_jobs = 2000::Int
sample_jobs <- sample' (vectorOf num_jobs $ do jobs <- genSample (vectorOf num_jobs $ do
num_ops <- choose (1, 5) num_ops <- choose (1, 5)
ops <- vectorOf num_ops genQueuedOpCode ops <- vectorOf num_ops genQueuedOpCode
jid <- genJobId jid <- genJobId
return $ QueuedJob jid ops justNoTs justNoTs return $ QueuedJob jid ops justNoTs justNoTs justNoTs)
justNoTs) let serialized = encode jobs
let jobs = head sample_jobs
serialized = encode jobs
-- check for non-ASCII fields, usually due to 'arbitrary :: String' -- check for non-ASCII fields, usually due to 'arbitrary :: String'
mapM_ (\job -> when (any (not . isAscii) (encode job)) . mapM_ (\job -> when (any (not . isAscii) (encode job)) .
assertFailure $ "Job has non-ASCII fields: " ++ show job assertFailure $ "Job has non-ASCII fields: " ++ show job
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -272,9 +272,8 @@ prop_Config_serialisation = ...@@ -272,9 +272,8 @@ prop_Config_serialisation =
case_py_compat_networks :: HUnit.Assertion case_py_compat_networks :: HUnit.Assertion
case_py_compat_networks = do case_py_compat_networks = do
let num_networks = 500::Int let num_networks = 500::Int
sample_networks <- sample' (vectorOf num_networks genValidNetwork) networks <- genSample (vectorOf num_networks genValidNetwork)
let networks = head sample_networks let networks_with_properties = map getNetworkProperties networks
networks_with_properties = map getNetworkProperties networks
serialized = J.encode networks serialized = J.encode networks
-- check for non-ASCII fields, usually due to 'arbitrary :: String' -- check for non-ASCII fields, usually due to 'arbitrary :: String'
mapM_ (\net -> when (any (not . isAscii) (J.encode net)) . mapM_ (\net -> when (any (not . isAscii) (J.encode net)) .
...@@ -322,9 +321,8 @@ getNetworkProperties net = ...@@ -322,9 +321,8 @@ getNetworkProperties net =
case_py_compat_nodegroups :: HUnit.Assertion case_py_compat_nodegroups :: HUnit.Assertion
case_py_compat_nodegroups = do case_py_compat_nodegroups = do
let num_groups = 500::Int let num_groups = 500::Int
sample_groups <- sample' (vectorOf num_groups genNodeGroup) groups <- genSample (vectorOf num_groups genNodeGroup)
let groups = head sample_groups let serialized = J.encode groups
serialized = J.encode groups
-- check for non-ASCII fields, usually due to 'arbitrary :: String' -- check for non-ASCII fields, usually due to 'arbitrary :: String'
mapM_ (\group -> when (any (not . isAscii) (J.encode group)) . mapM_ (\group -> when (any (not . isAscii) (J.encode group)) .
HUnit.assertFailure $ HUnit.assertFailure $
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
{- {-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
...@@ -440,10 +440,9 @@ case_AllDefined = do ...@@ -440,10 +440,9 @@ case_AllDefined = do
case_py_compat_types :: HUnit.Assertion case_py_compat_types :: HUnit.Assertion