-- Copyright 2020 Google LLC -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License. -- You may obtain a copy of the License at -- -- http://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -- See the License for the specific language governing permissions and -- limitations under the License. {-# LANGUAGE ScopedTypeVariables #-} module DynamicUTest(test) where import Control.DeepSeq import Control.Exception import Data.Array.DynamicU import qualified Data.Vector.Unboxed as V import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (assertEqual, assertFailure, Assertion) assertThrows :: (NFData a) => String -> a -> Assertion assertThrows s a = catch (deepseq a $ assertFailure s) (\ (_ :: ErrorCall) -> return ()) test :: Test test = testGroup "DynamicU" $ let a1, a2 :: Array Int a1 = fromList [2,3] [1..6] a2 = transpose [1,0] a1 show_1 = assertEqual "1" "fromList [2,3] [1,2,3,4,5,6]" (show a1) show_2 = assertEqual "2" "fromList [3,2] [1,4,2,5,3,6]" (show a2) eq_1 = assertEqual "1" True (a1 == a1) eq_2 = assertEqual "2" False (a1 == a2) ord_1 = assertEqual "1" EQ (a1 `compare` a1) ord_2 = assertEqual "2" LT (a1 `compare` a2) shapeL_1 = assertEqual "1" [2,3] (shapeL a1) shapeL_2 = assertEqual "2" [3,2] (shapeL a2) rank_1 = assertEqual "1" 2 (rank a1) rank_2 = assertEqual "2" 2 (rank a2) index_1 = assertEqual "1" (fromList [3] [1,2,3]) (index a1 0) index_2 = assertEqual "2" (fromList [2] [1,4]) (index a2 0) index_3 = assertEqual "3" (fromList [] [4]) (a2 `index` 0 `index` 1) index_4 = assertThrows "<0" (index a1 (-1)) index_5 = assertThrows ">" (index a1 2) toList_1 = assertEqual "1" [1,2,3,4,5,6] (toList a1) toList_2 = assertEqual "2" [1,4,2,5,3,6] (toList a2) toVector_1 = assertEqual "1" (V.fromList [1,2,3,4,5,6]) (toVector a1) toVector_2 = assertEqual "2" (V.fromList [1,4,2,5,3,6]) (toVector a2) fromList_1 = assertThrows "sh" (fromList [] [1,2::Int]) fromList_2 = assertThrows "sh" (fromList [4,5] [1,2::Int]) fromVector_1 = assertEqual "1" a1 (fromVector [2,3] $ V.fromList [1..6]) normalize_1 = assertEqual "1" a1 (normalize a1) reshape_1 = assertEqual "1" (fromList [6] [1..6]) (reshape [6] a1) reshape_2 = assertEqual "1" (fromList [1,2,3,1] [1,4,2,5,3,6]) (reshape [1,2,3,1] a2) a3, a4 :: Array Int a3 = fromList [1] [5] a4 = fromList [] [5] stretch_1 = assertEqual "1" (fromList [3] [5,5,5]) (stretch [3] a3) stretch_2 = assertEqual "2" (fromList [2,2,3,2] [1,1,2,2,3,3,4,4,5,5,6,6,1,1,2,2,3,3,4,4,5,5,6,6]) (stretch [2,2,3,2] $ reshape [1,2,3,1] a1) stretch_3 = assertThrows "3" (stretch [1,2] a3) stretch_4 = assertThrows "4" (stretch [4,3] a1) scalar_1 = assertEqual "1" a4 (scalar 5) unScalar_1 = assertEqual "1" 5 (unScalar a4) unScalar_2 = assertThrows "2" (unScalar a3) constant_1 = assertEqual "1" (fromList [2,3] [1,1,1,1,1,1]) (constant [2,3] (1::Int)) mapA_1 = assertEqual "1" (fromList [2,3] [2..7]) (mapA succ a1) mapA_2 = assertEqual "1" (fromList [3,2] [2,5,3,6,4,7]) (mapA succ a2) zipWithA_1 = assertEqual "1" (fromList [2,3] [2,4..12]) (zipWithA (+) a1 a1) zipWithA_2 = assertThrows "2" (zipWithA (+) a1 a2) zipWith3A_1 = assertEqual "1" (fromList [2,3] [2,6,12,20,30,42]) (zipWith3A (\ x y z -> x*y+z) a1 a1 a1) pad_1 = assertEqual "1" (fromList [5,10] [9,9,9,9,9,9,9,9,9,9, 9,9,9,1,2,3,9,9,9,9, 9,9,9,4,5,6,9,9,9,9, 9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9]) (pad [(1,2),(3,4)] 9 a1) pad_2 = assertThrows "2" (pad [(1,1),(1,1),(1,1)] 0 a1) a5 :: Array Int a5 = fromList [2,3,4] [1..24] transpose_1 = assertEqual "1" (fromList [2,3,4] [1,2,3,4, 5,6,7,8, 9,10,11,12, 13,14,15,16, 17,18,19,20, 21,22,23,24]) (transpose [0,1,2] a5) transpose_2 = assertEqual "2" (fromList [2,4,3] [1,5,9, 2,6,10, 3,7,11, 4,8,12, 13,17,21, 14,18,22, 15,19,23, 16,20,24]) (transpose [0,2,1] a5) transpose_3 = assertEqual "3" (fromList [3,2,4] [1,2,3,4, 13,14,15,16, 5,6,7,8, 17,18,19,20, 9,10,11,12, 21,22,23,24]) (transpose [1,0,2] a5) transpose_4 = assertEqual "4" (fromList [3,4,2] [1,13, 2,14, 3,15, 4,16, 5,17, 6,18, 7,19, 8,20, 9,21, 10,22, 11,23, 12,24]) (transpose [1,2,0] a5) transpose_5 = assertEqual "5" (fromList [4,2,3] [1,5,9, 13,17,21, 2,6,10, 14,18,22, 3,7,11, 15,19,23, 4,8,12, 16,20,24]) (transpose [2,0,1] a5) transpose_6 = assertEqual "6" (fromList [4,3,2] [1,13, 5,17, 9,21, 2,14, 6,18, 10,22, 3,15, 7,19, 11,23, 4,16, 8,20, 12,24]) (transpose [2,1,0] a5) transpose_7 = assertThrows "7" (transpose [0,1,2,3] a5) transpose_8 = assertThrows "7" (transpose [0,1,3] a5) transpose_9 = assertEqual "9" (fromList [3,2,4] [1,2,3,4, 13,14,15,16, 5,6,7,8, 17,18,19,20, 9,10,11,12, 21,22,23,24]) (transpose [1,0] a5) append_1 = assertEqual "1" (fromList [3,3] [1..9]) (append a1 (fromList [1,3] [7,8,9])) concatOuter_1 = assertEqual "1" (fromList [6,3] [1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6]) (concatOuter [a1, concatOuter [a1,a1]]) concatOuter_2 = assertThrows "2" (concatOuter [a1, a2]) a6 :: Array Int a6 = fromList [4,5] [1..20] window_1 = assertEqual "1" (fromList [2,3,3,3] [1,2,3, 6,7,8, 11,12,13, 2,3,4, 7,8,9, 12,13,14, 3,4,5, 8,9,10, 13,14,15, 6,7,8, 11,12,13, 16,17,18, 7,8,9, 12,13,14, 17,18,19, 8,9,10, 13,14,15, 18,19,20]) (window [3,3] a6) window_2 = assertThrows "2" (window [3,6] a6) window_3 = assertThrows "3" (window [3,3,3] a6) stride_1 = assertEqual "1" (fromList [2,2,2] [1,3, 9,11, 13,15, 21,23]) (stride [1,2,2] a5) stride_2 = assertThrows "2" (stride [1,2,2] a1) slice_1 = assertEqual "1" (fromList [2,2,1] [8,12,20,24]) (slice [(0,2),(1,2),(3,1)] a5) slice_2 = assertThrows "2" (slice [(0,0)] a4) slice_3 = assertThrows "3" (slice [(-1,1)] a5) slice_4 = assertThrows "4" (slice [(10,0)] a5) slice_5 = assertThrows "5" (slice [(0,3)] a5) a7 = mapA succ a5 dot x y = reduce (+) 0 $ zipWithA (*) x y rerank2_1 = assertEqual "1" (fromList [2,3] [40,200,488,904,1448,2120]) (rerank2 2 dot a5 a7) rev_1 = assertEqual "1" (fromList [2,3] [3,2,1,6,5,4]) (rev [1] a1) rev_2 = assertEqual "2" (fromList [2,3] [6,5,4,3,2,1]) (rev [0,1] a1) rev_3 = assertThrows "3" (rev [2] a1) reduce_1 = assertEqual "1" (scalar 720) (reduce (*) 1 a1) reduce_2 = assertEqual "2" (fromList [2] [6,120]) (rerank 1 (reduce (*) 1) a1) reduce_3 = assertEqual "3" (fromList [3] [4,10,18]) (rerank 1 (reduce (*) 1) a2) tests = [ testCase "show_1" show_1 , testCase "show_2" show_2 , testCase "eq_1" eq_1 , testCase "eq_2" eq_2 , testCase "ord_1" ord_1 , testCase "ord_2" ord_2 , testCase "shapeL_1" shapeL_1 , testCase "shapeL_2" shapeL_2 , testCase "rank_1" rank_1 , testCase "rank_2" rank_2 , testCase "index_1" index_1 , testCase "index_2" index_2 , testCase "index_3" index_3 , testCase "index_4" index_4 , testCase "index_5" index_5 , testCase "toList_1" toList_1 , testCase "toList_2" toList_2 , testCase "toVector_1" toVector_1 , testCase "toVector_2" toVector_2 , testCase "fromList_1" fromList_1 , testCase "fromList_2" fromList_2 , testCase "fromVector_1" fromVector_1 , testCase "normalize_1" normalize_1 , testCase "reshape_1" reshape_1 , testCase "reshape_2" reshape_2 , testCase "stretch_1" stretch_1 , testCase "stretch_2" stretch_2 , testCase "stretch_3" stretch_3 , testCase "stretch_4" stretch_4 , testCase "scalar_1" scalar_1 , testCase "unScalar_1" unScalar_1 , testCase "unScalar_2" unScalar_2 , testCase "constant_1" constant_1 , testCase "mapA_1" mapA_1 , testCase "mapA_2" mapA_2 , testCase "zipWithA_1" zipWithA_1 , testCase "zipWithA_2" zipWithA_2 , testCase "zipWith3A_1" zipWith3A_1 , testCase "pad_1" pad_1 , testCase "pad_2" pad_2 , testCase "transpose_1" transpose_1 , testCase "transpose_2" transpose_2 , testCase "transpose_3" transpose_3 , testCase "transpose_4" transpose_4 , testCase "transpose_5" transpose_5 , testCase "transpose_6" transpose_6 , testCase "transpose_7" transpose_7 , testCase "transpose_8" transpose_8 , testCase "transpose_9" transpose_9 , testCase "append_1" append_1 , testCase "concatOuter_1" concatOuter_1 , testCase "concatOuter_2" concatOuter_2 , testCase "window_1" window_1 , testCase "window_2" window_2 , testCase "window_3" window_3 , testCase "stride_1" stride_1 , testCase "stride_2" stride_2 , testCase "slice_1" slice_1 , testCase "slice_2" slice_2 , testCase "slice_3" slice_3 , testCase "slice_4" slice_4 , testCase "slice_5" slice_5 , testCase "rerank2_1" rerank2_1 , testCase "rev_1" rev_1 , testCase "rev_2" rev_2 , testCase "rev_3" rev_3 , testCase "reduce_1" reduce_1 , testCase "reduce_2" reduce_2 , testCase "reduce_3" reduce_3 ] in tests