fprog2021WS/code/Test6.hs

module Test6 where

import Angabe6
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.Ingredients (composeReporters)
import Test.Tasty.Ingredients.ConsoleReporter (consoleTestReporter)
import Control.Exception (ErrorCall(ErrorCallWithLocation), try, evaluate)

main :: IO ()
main = defaultMainWithIngredients [consoleTestReporter] spec

{-----TESTDATEN BEGINN-----}
m0 = Mf (2,2) (\_ _ -> 0)   :: MatrixF
m1 = Mf (2,2) (\z s -> if z == 1 then s else z+s)   :: MatrixF
m2 = Mf (2,2) (\z s -> s + ((z-1)*(snd (2,2))))     :: MatrixF
m3 = Mf (2,2) (\z s -> s + ((z-1)*(snd (mtyp m2)))) :: MatrixF
m4 = Mf (2,2) (\z s -> if z == 1 then (succ (fib (s-1))) else ((+) z (binom z (s-1)))) :: MatrixF
m5 = Mf (3,2) (\z s -> if z == 1 then s else if z == 2 then z+s else succ (z+s+1))     :: MatrixF
m6 = Mf (3,2) (\z s -> z*s + ((z-1)*(snd (mtyp m5)))) :: MatrixF
mF = Mf (0,0) (\_ _ -> 0)   :: MatrixF
m7 = Mf (1,0) (\z s -> z+s) :: MatrixF
m8 = Mf (0,1) (\z s -> z+s) :: MatrixF
m9 = Mf (2,3) (\z s -> z-s) :: MatrixF
m10 = Mf (2,2) (\_ _ -> -5) :: MatrixF
m11 = Mf (5,9) (\z s -> (z * (-s) + fib s)) :: MatrixF
m12 = Mf (9,5) (\z s -> (z * s) `mod` 4) :: MatrixF

-- Hilfsfunktionen
fib :: Nat0 -> Nat1
fib 0 = 0
fib 1 = 1
fib n = fib (n-2) + fib (n-1)

binom :: Nat0 -> Nat0 -> Nat1
binom n k
	| n == 0 || n == k = 1
	| otherwise 	   = binom (n-1) (k-1) + binom (n-1) k

-- Error Messages
errGl = "Gleichheit undefiniert" :: String
errUn = "Ungleichheit undefiniert" :: String
errSg = "Vorzeichenfunktion undefiniert" :: String
{-----TESTDATEN ENDE-----}


getMsg :: ErrorCall -> String
getMsg (ErrorCallWithLocation msg _) = msg

assertError :: (Show a) => String -> a -> IO ()
assertError errorMsg action = do
	r <- try (evaluate action)
	case r of
		Left e -> if (getMsg e == errorMsg) then return()
				  else assertFailure $ "Received unexpected error: " ++ (show e) ++ "\ninstead of: " ++ errorMsg
		Right _ -> assertFailure $ "Expected error: " ++ errorMsg

spec :: TestTree
spec =
	testGroup
		"Test2 Spec"
		[
			showMatrixF_tests,
			matrixtyp_tests,
			equality_tests,
			num_tests
		]

showMatrixF_tests :: TestTree
showMatrixF_tests =
	testGroup
		"-show MatrixF Tests----------"
		[
			testCase "show m1" $
				show m1 @?= "([1,2] [3,4])",
			testCase "show m2" $
				show m2 @?= "([1,2] [3,4])",
			testCase "show m3" $
				show m3 @?= "([1,2] [3,4])",
			testCase "show m4" $
				show m4 @?= "([1,2] [6,5])",
			testCase "show m5" $
				show m5 @?= "([1,2] [3,4] [6,7])",
			testCase "show m6" $
				show m6 @?= "([1,2] [4,6] [7,10])",
			testCase "show mF" $
				show mF @?= "()",
			testCase "show m7" $
				show m7 @?= "()"
		]

matrixtyp_tests :: TestTree
matrixtyp_tests =
	testGroup
		"-matrixtyp Tests----------"
		[
			testCase "matrixtyp m5" $
				matrixtyp m5 @?= Just (3,2),
			testCase "matrixtyp mF" $
				matrixtyp mF @?= Nothing,
			testCase "matrixtyp m7" $
				matrixtyp m7 @?= Nothing,
			testCase "matrixtyp m8" $
				matrixtyp m8 @?= Nothing
		]

equality_tests :: TestTree
equality_tests =
	testGroup
		"-equality Tests----------"
		[
			testCase "m1 == m2" $
				m1 == m2 @?= True,
			testCase "m1 == m5" $
				m1 == m5 @?= False,
			testCase "m1 == mF" $
				assertError errGl (m1 == mF),
			testCase "mF == m1" $
				assertError errGl (mF == m1),
			testCase "mF == m7" $
				assertError errGl (mF == m7),
			testCase "m1 /= m2" $
				m1 /= m2 @?= False,
			testCase "m1 /= m5" $
				m1 /= m5 @?= True,
			testCase "m1 /= mF" $
				assertError errUn (m1 /= mF),
			testCase "mF /= m1" $
				assertError errUn (mF /= m1),
			testCase "mF /= m7" $
				assertError errUn (mF /= m7)
		]

num_tests :: TestTree
num_tests =
	testGroup
		"-Num Tests----------"
		[
			testCase "m1 + m2" $
				show (m1 + m2) @?= "([2,4] [6,8])",
			testCase "m1 + m5" $
				show (m1 + m5) @?= "()",
			testCase "m1 + mF" $
				show (m1 + mF) @?= "()",
			testCase "m1 + m7" $
				show (m1 + m7) @?= "()",
			testCase "m7 + m1" $
				show (m7 + m1) @?= "()",
			testCase "m1 - m2" $
				show (m1 - m2) @?= "([0,0] [0,0])",
			testCase "m1 - m4" $
				show (m1 - m4) @?= "([0,0] [-3,-1])",
			testCase "m1 - m5" $
				show (m1 - m5) @?= "()",
			testCase "m1 - mF" $
				show (m1 - mF) @?= "()",
			testCase "m1 - m7" $
				show (m1 - m7) @?= "()",
			testCase "m7 - m1" $
				show (m7 - m1) @?= "()",
			testCase "m1 * m2" $
				show (m1 * m2) @?= "([7,10] [15,22])",
			testCase "m1 * m5" $
				show (m1 * m5) @?= "()",
			testCase "m1 * mF" $
				show (m1 * mF) @?= "()",
			testCase "m5 * m9" $
				show (m5 * m9) @?= "([2,-1,-4] [4,-3,-10] [7,-6,-19])",
			testCase "m11 * ,12" $
				show (m11 * m12) @?= "([42,60,82,0,42] [-19,10,11,0,-19] [-80,-40,-60,0,-80] [-141,-90,-131,0,-141] [-202,-140,-202,0,-202])",
			testCase "negate m0" $
				show (negate m0) @?= "([0,0] [0,0])",
			testCase "negate m9" $
				show (negate m9) @?= "([0,1,2] [-1,0,1])",
			testCase "negate mF" $
				show (negate mF) @?= "()",
			testCase "abs m0" $
				show (abs m0) @?= "([0,0] [0,0])",
			testCase "abs m9" $
				show (abs m9) @?= "([0,1,2] [1,0,1])",
			testCase "abs mF" $
				show (abs mF) @?= "()",
			testCase "signum m0" $
				show (signum m0) @?= "([0])",
			testCase "signum m1" $
				show (signum m1) @?= "([1])",
			testCase "signum m9" $
				assertError errSg (signum m9),
			testCase "signum m10" $
				show (signum m10) @?= "([-1])"
		]