diff --git a/common/Utils.hs b/common/Utils.hs index 6f9f32f..c0cbd56 100644 --- a/common/Utils.hs +++ b/common/Utils.hs @@ -272,3 +272,6 @@ showMaybe _ Nothing = "Nothing" showListCustom :: (a -> String) -> [a] -> String showListCustom showFunc list = "[" ++ concat (intersperse "," (map showFunc list)) ++ "]" + +showPairCustom :: (a -> String) -> (b -> String) -> (a,b) -> String +showPairCustom showA showB (a,b) = "(" ++ showA a ++ "," ++ showB b ++ ")" diff --git a/transformations/ArrayUsageCheckTest.hs b/transformations/ArrayUsageCheckTest.hs index 615cfac..ad0fe29 100644 --- a/transformations/ArrayUsageCheckTest.hs +++ b/transformations/ArrayUsageCheckTest.hs @@ -496,8 +496,9 @@ translateEquations mp = seqPair . transformPair (mapM swapColumns) (mapM swapCol -- | Asserts that the two problems are equivalent, once you take into account the potentially different variable mappings assertEquivalentProblems :: String -> [(VarMap, (EqualityProblem, InequalityProblem))] -> [(VarMap, (EqualityProblem, InequalityProblem))] -> Assertion -assertEquivalentProblems title exp act = assertEqual (title ++ " list sizes") (length exp) (length act) - >> ((uncurry $ assertEqualCustomShow (showListCustom $ showMaybe showProblem) title) $ unzip $ map (uncurry transform) $ zip exp act) +assertEquivalentProblems title exp act + = ((uncurry $ assertEqualCustomShow (showPairCustom show $ showListCustom $ showMaybe showProblem) title) + $ pairPairs (length exp, length act) $ unzip $ map (uncurry transform) $ zip exp act) where transform :: (VarMap, (EqualityProblem, InequalityProblem)) -> (VarMap, (EqualityProblem, InequalityProblem)) -> ( Maybe (EqualityProblem, InequalityProblem), Maybe (EqualityProblem, InequalityProblem) ) @@ -508,6 +509,8 @@ assertEquivalentProblems title exp act = assertEqual (title ++ " list sizes") (l translatedExp = ( generateMapping (fst exp) (fst act) >>= flip translateEquations (snd exp)) >>* sortP + pairPairs (xa,ya) (xb,yb) = ((xa,xb), (ya,yb)) + checkRight :: Show a => Either a b -> IO b checkRight (Left err) = assertFailure ("Not Right: " ++ show err) >> return undefined checkRight (Right x) = return x