diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index 5ec30bdcf79827b4b68f3237f8888056d944e7e4..d8e6de1865137932817d1278bca04491cddbaab4 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -7,7 +7,7 @@ goes into the "Main" module for the individual binaries.
 
 {-
 
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 Google Inc.
 
 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
@@ -632,7 +632,8 @@ iterateAlloc :: Node.List
              -> Instance.Instance
              -> Int
              -> [Instance.Instance]
-             -> Result (FailStats, Node.List, [Instance.Instance])
+             -> Result (FailStats, Node.List, Instance.List,
+                        [Instance.Instance])
 iterateAlloc nl il newinst nreq ixes =
       let depth = length ixes
           newname = printf "new-%d" depth::String
@@ -642,9 +643,10 @@ iterateAlloc nl il newinst nreq ixes =
            Bad s -> Bad s
            Ok (errs, _, sols3) ->
                case sols3 of
-                 [] -> Ok (collapseFailures errs, nl, ixes)
+                 [] -> Ok (collapseFailures errs, nl, il, ixes)
                  (_, (xnl, xi, _)):[] ->
-                     iterateAlloc xnl il newinst nreq $! (xi:ixes)
+                     iterateAlloc xnl (Container.add newidx xi il)
+                                  newinst nreq $! (xi:ixes)
                  _ -> Bad "Internal error: multiple solutions for single\
                           \ allocation"
 
@@ -653,16 +655,17 @@ tieredAlloc :: Node.List
             -> Instance.Instance
             -> Int
             -> [Instance.Instance]
-            -> Result (FailStats, Node.List, [Instance.Instance])
+            -> Result (FailStats, Node.List, Instance.List,
+                       [Instance.Instance])
 tieredAlloc nl il newinst nreq ixes =
     case iterateAlloc nl il newinst nreq ixes of
       Bad s -> Bad s
-      Ok (errs, nl', ixes') ->
+      Ok (errs, nl', il', ixes') ->
           case Instance.shrinkByType newinst . fst . last $
                sortBy (comparing snd) errs of
-            Bad _ -> Ok (errs, nl', ixes')
+            Bad _ -> Ok (errs, nl', il', ixes')
             Ok newinst' ->
-                tieredAlloc nl' il newinst' nreq ixes'
+                tieredAlloc nl' il' newinst' nreq ixes'
 
 -- * Formatting functions
 
diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs
index 1f2a460c36b3dd4e97dbd06e50be549c89dc01b4..6cc36a85e8c7ef2b06e0e5521e3ec7051c6f3fc7 100644
--- a/Ganeti/HTools/QC.hs
+++ b/Ganeti/HTools/QC.hs
@@ -643,7 +643,8 @@ prop_ClusterCanTieredAlloc node inst =
         il = Container.empty
     in case Cluster.tieredAlloc nl il inst rqnodes [] of
          Types.Bad _ -> False
-         Types.Ok (_, _, ixes) -> not (null ixes)
+         Types.Ok (_, _, il, ixes) -> not (null ixes) &&
+                                      IntMap.size il == length ixes
 
 -- | Checks that on a 4-8 node cluster, once we allocate an instance,
 -- we can also evacuate it
@@ -686,12 +687,9 @@ prop_ClusterAllocBalance node =
         i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
     in case Cluster.iterateAlloc nl' il i_templ rqnodes [] of
          Types.Bad _ -> False
-         Types.Ok (_, xnl, insts) ->
+         Types.Ok (_, xnl, il', insts) ->
                    let ynl = Container.add (Node.idx hnode) hnode xnl
                        cv = Cluster.compCV ynl
-                       il' = foldl (\l i ->
-                                        Container.add (Instance.idx i) i l)
-                             il insts
                        tbl = Cluster.Table ynl il' cv []
                    in canBalance tbl True False
 
diff --git a/hspace.hs b/hspace.hs
index ee420efa5352c49bda55353ccefee9455a25d4a3..87b6fd3c14b88928e80200953c3f14fdcdf24066 100644
--- a/hspace.hs
+++ b/hspace.hs
@@ -261,7 +261,7 @@ main = do
 
   let bad_nodes = fst $ Cluster.computeBadItems nl il
       stop_allocation = length bad_nodes > 0
-      result_noalloc = ([(FailN1, 1)]::FailStats, nl, [])
+      result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [])
 
   -- utility functions
   let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
@@ -280,7 +280,7 @@ main = do
   (case optTieredSpec opts of
      Nothing -> return ()
      Just tspec -> do
-       (_, trl_nl, trl_ixes) <-
+       (_, trl_nl, _, trl_ixes) <-
            if stop_allocation
            then return result_noalloc
            else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
@@ -311,7 +311,7 @@ main = do
 
   -- Run the standard (avg-mode) allocation
 
-  (ereason, fin_nl, ixes) <-
+  (ereason, fin_nl, _, ixes) <-
       if stop_allocation
       then return result_noalloc
       else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])