Refactored some of ArrayUsageCheckTest, simplified it a little and corrected a bug in the test framework

Previously, the assertEquivalentProblems function and functions used by it dealt with results inside Maybe, sometimes then inside IO.  These functions have been migrated to the new TestMonad.  Instead of using Maybe, any problems with the test are dealt with by failing the test instead.

The assertEquivalentProblems function used to take a list of labelled expressions for comparison purposes.  Now that we have an ordering on the AST, this is pointless.  Instead we can directly sort the lists by the expressions involved.  This simplifies the code a little.

Finally, a bug has been fixed.  The mapping between expected and actual columns in the swapColumns' function of translateEquations was being used as a backward mapping, even though it was in fact a forward mapping.  So that has also been corrected.

checks/ArrayUsageCheckTest.hs

@@ -436,12 +436,12 @@ testMakeEquations = TestLabel "testMakeEquations" $ TestList
   
     test' :: (Integer,[((Int,Int),VarMap,[HandyEq],[HandyIneq])],[A.Expression],A.Expression) -> Test
     test' (ind, problems, exprs, upperBound) = 
-      TestCase $ assertEquivalentProblems ("testMakeEquations " ++ show ind) (zip [0..] exprs)
+      TestCase $ assertEquivalentProblems ("testMakeEquations " ++ show ind)
         (map (transformTriple (applyPair (exprs !!)) id (uncurry makeConsistent)) $ map pairLatterTwo problems) =<< (checkRight $ makeEquations [] (makeParItems exprs) upperBound)
   
     testRep' :: (Integer,[((Int, Int), VarMap,[HandyEq],[HandyIneq])],(String, A.Expression, A.Expression),[A.Expression],A.Expression) -> Test
     testRep' (ind, problems, (repName, repFrom, repFor), exprs, upperBound) = 
-      TestCase $ assertEquivalentProblems ("testMakeEquations " ++ show ind) (zip [0..] exprs)
+      TestCase $ assertEquivalentProblems ("testMakeEquations " ++ show ind)
         (map (transformTriple (applyPair (exprs !!)) id (uncurry makeConsistent)) $ map pairLatterTwo problems)
           =<< (checkRight $ makeEquations [] (RepParItem (A.For emptyMeta (simpleName repName) repFrom repFor) $ makeParItems exprs) upperBound)
   
@@ -610,28 +610,34 @@ testIndexes = TestList
 -- | Given one mapping and a second mapping, gives a function that converts the indexes
 -- from one to the indexes of the next.  If any of the keys in the map don't match
 -- (i.e. if (keys m0 /= keys m1)) Nothing will be returned
-generateMapping :: VarMap -> VarMap -> Maybe [(CoeffIndex,CoeffIndex)]
+
-generateMapping m0 m1 = if Map.keys m0 /= Map.keys m1 then Nothing else Just (Map.elems $ zipMap mergeMaybe m0 m1)
+generateMapping :: TestMonad m r => VarMap -> VarMap -> m [(CoeffIndex,CoeffIndex)]
+generateMapping m0 m1
+  = do testEqual "Keys in variable mapping" (Map.keys m0) (Map.keys m1)
+       return $ Map.elems $ zipMap mergeMaybe m0 m1
 
 -- | Given a forward mapping list, translates equations across
 translateEquations :: forall m r. TestMonad m r =>
-  [(CoeffIndex,CoeffIndex)] -> (EqualityProblem, InequalityProblem) -> m (Maybe (EqualityProblem, InequalityProblem))
+  [(CoeffIndex,CoeffIndex)] -> (EqualityProblem, InequalityProblem) -> m (EqualityProblem, InequalityProblem)
 translateEquations mp (eq,ineq)
   = do testEqual "translateEquations mapping not one-to-one" (sort $ map fst mp) (sort $ map snd mp)
        testCompareCustom "translateEquations input not square" (>=) 1 $ length $ nub $ map (snd . bounds) $ eq ++ ineq
-       eq' <- mapM swapColumns eq >>* sequence -- mapM is in the IO monad, sequence is in the Maybe monad
+       eq' <- mapM swapColumns eq
-       ineq' <- mapM swapColumns ineq >>* sequence
+       ineq' <- mapM swapColumns ineq
-       return $ mergeMaybe eq' ineq'
+       return (eq', ineq')
   where
-    swapColumns :: Array CoeffIndex Integer -> m (Maybe (Array CoeffIndex Integer))
+    swapColumns :: Array CoeffIndex Integer -> m (Array CoeffIndex Integer)
     swapColumns arr
-      = case mapM swapColumns' $ assocs arr of
+      = do swapped <- mapM swapColumns' $ assocs arr
-          Just swapped -> check arr swapped >> (return . Just $ simpleArray swapped)
+           check arr swapped
-          Nothing -> return Nothing
+           return $ simpleArray swapped
       where
-        swapColumns' :: (CoeffIndex,Integer) -> Maybe (CoeffIndex,Integer)
+        swapColumns' :: (CoeffIndex,Integer) -> m (CoeffIndex,Integer)
-        swapColumns' (0,v) = Just (0,v) -- Never swap the units column
+        swapColumns' (0,v) = return (0,v) -- Never swap the units column
-        swapColumns' (x,v) = transformMaybe (\y -> (y,v)) $ transformMaybe fst $ find ((== x) . snd) mp
+        swapColumns' (x,v)
+          = case find ((== x) . fst) mp of
+              Just (_,y) -> return (y,v)
+              Nothing -> testFailure "Could not find column to swap to"  >> return undefined
     
     check :: Show a => a -> [(CoeffIndex,Integer)] -> m ()
     check x ies = if length ies == 1 + maximum (map fst ies) then return () else
@@ -639,46 +645,39 @@ translateEquations mp (eq,ineq)
          ++ " value beforehand was: " ++ show x ++ " mapping was: " ++ show mp
 
 -- | Asserts that the two problems are equivalent, once you take into account the potentially different variable mappings
-assertEquivalentProblems :: forall m r. TestMonad m r => String -> [(Int, A.Expression)] -> [((A.Expression, A.Expression), VarMap, (EqualityProblem, InequalityProblem))] ->
+assertEquivalentProblems :: forall m r. (TestMonad m r) => String -> [((A.Expression, A.Expression), VarMap, (EqualityProblem, InequalityProblem))] ->
   [((A.Expression, A.Expression), VarMap, (EqualityProblem, InequalityProblem))] -> m ()
-assertEquivalentProblems title indExpr exp act
+assertEquivalentProblems title exp act
   = do transformed <- mapM (uncurry transform) $ map (uncurry checkLabel) $ zip (sortByLabels exp) (sortByLabels act)
        (uncurry $ testEqualCustomShow showFunc title)
          $ pairPairs (length exp, length act) $ transformPair sortProblem sortProblem $ unzip $ transformed
   where
-    showFunc :: (Int, [Maybe (EqualityProblem, InequalityProblem)]) -> String
+    showFunc :: (Int, [(EqualityProblem, InequalityProblem)]) -> String
-    showFunc = showPairCustom show $ showListCustom $ showMaybe showProblem
+    showFunc = showPairCustom show $ showListCustom $ showProblem
   
     -- Since this is a test, I'm taking the lazy way out and allowing run-time errors in this
     -- function rather than putting it all in a monad.  In HUnit the effect will be about the same
-    checkLabel :: ((Int, Int), VarMap, (EqualityProblem, InequalityProblem)) ->
+    checkLabel :: (Show label, Ord label) => ((label, label), VarMap, (EqualityProblem, InequalityProblem)) ->
-      ((Int, Int), VarMap, (EqualityProblem, InequalityProblem)) ->
+      ((label, label), VarMap, (EqualityProblem, InequalityProblem)) ->
       ((VarMap, (EqualityProblem, InequalityProblem)), (VarMap, (EqualityProblem, InequalityProblem)))
     checkLabel (l,vm,p) (l',vm',p')
       | l == l'   = ((vm,p), (vm',p'))
       | otherwise = error $ "Labels did not match, expected: " ++ show l ++ " but actual: " ++ show l'
   
     sortByLabels :: [((A.Expression, A.Expression), VarMap, (EqualityProblem, InequalityProblem))] ->
-       [((Int, Int), VarMap, (EqualityProblem, InequalityProblem))]
+       [((A.Expression, A.Expression), VarMap, (EqualityProblem, InequalityProblem))]
-    sortByLabels = sortBy (comparing (\(l,_,_) -> l)) . map lookupIndexes
+    sortByLabels = sortBy (comparing (\(l,_,_) -> l)) . map (\(es,b,c) -> (sortPair es, b, c))
     
-    sortPair :: (Int,Int) -> (Int, Int)
+    sortPair :: Ord a => (a,a) -> (a, a)
     sortPair (x,y) | x <= y    = (x,y)
                    | otherwise = (y,x)
 
-    lookupIndexes :: ((A.Expression, A.Expression), VarMap, (EqualityProblem, InequalityProblem)) ->
-      ((Int, Int), VarMap, (EqualityProblem, InequalityProblem))
-    lookupIndexes ((e,e'),vm, p) = (sortPair (lookup e, lookup e'), vm, p)
-      where
-        lookup e = maybe (-1) fst $ find ((== e) . snd) indExpr
-
     transform :: (VarMap, (EqualityProblem, InequalityProblem)) -> (VarMap, (EqualityProblem, InequalityProblem)) ->
-                       m ( Maybe (EqualityProblem, InequalityProblem), Maybe (EqualityProblem, InequalityProblem) )
+                       m ( (EqualityProblem, InequalityProblem), (EqualityProblem, InequalityProblem) )
     transform exp@(_, (e_eq, e_ineq)) act@(_, (a_eq, a_ineq))
-      = do translatedExp <- case generateMapping (fst exp) (fst act) of
+      = do mapping <- generateMapping (fst exp) (fst act)
-             Just mapping -> translateEquations mapping (resize e_eq, resize e_ineq)
+           translatedExp <- translateEquations mapping (resize e_eq, resize e_ineq)
-             Nothing -> return Nothing
+           return (sortP translatedExp, sortP $ transformPair resize resize $ snd act)
-           return (translatedExp >>* sortP, Just $ sortP $ transformPair resize resize $ snd act)
       where
         size = maximum $ map (snd . bounds) $ concat [e_eq, e_ineq, a_eq, a_ineq]
 
@@ -691,11 +690,11 @@ assertEquivalentProblems title indExpr exp act
         
     pairPairs (xa,ya) (xb,yb) = ((xa,xb), (ya,yb))
     
-    sortProblem :: [Maybe (EqualityProblem, InequalityProblem)] -> [Maybe (EqualityProblem, InequalityProblem)]
+    sortProblem :: [(EqualityProblem, InequalityProblem)] -> [(EqualityProblem, InequalityProblem)]
     sortProblem = sort
 
-checkRight :: Show a => Either a b -> IO b
+checkRight :: (Show a, TestMonad m r) => Either a b -> m b
-checkRight (Left err) = assertFailure ("Not Right: " ++ show err) >> return undefined
+checkRight (Left err) = testFailure ("Not Right: " ++ show err) >> return undefined
 checkRight (Right x) = return x
 
 -- QuickCheck tests for Omega Test: