[robocop] 10/37: Update testfunctions

[Admin]

This is an automated email from the git hooks/post-receive script.

grothoff pushed a commit to branch master
in repository robocop.

commit a6ade832418011bc15e275ae2c69b445d837d9f0
Author: Vint Leenaars <vl.software@leenaa.rs>
AuthorDate: Mon May 5 18:59:39 2025 +0200

    Update testfunctions
---
 test/Tests/Check.hs | 78 +++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 55 insertions(+), 23 deletions(-)

diff --git a/test/Tests/Check.hs b/test/Tests/Check.hs
index ffc0837..260d705 100644
--- a/test/Tests/Check.hs
+++ b/test/Tests/Check.hs
@@ -39,7 +39,7 @@ data Distribution = Distribution
 testFakeTarget :: Bool -> Int -> NaturalPerson -> Map Int Individual -> 
Distribution -> TestTree
 testFakeTarget verbose number target sanction_list distribution =
   testGroup ("Test fake target " ++ show number)
-    [ testSingleTarget verbose (show number) target distribution
+    [ testSingleTarget verbose number target distribution Nothing
     , dontFindTarget   verbose target sanction_list ("target " ++ show number)
     ]
 
@@ -48,10 +48,32 @@ testFakeTarget verbose number target sanction_list 
distribution =
 testTarget :: Bool -> Int -> NaturalPerson -> Map Int Individual -> 
Distribution -> TestTree
 testTarget verbose number target sanction_list distribution =
   testGroup ("Test target " ++ show number)
-    [ testSingleTarget verbose (show number) target distribution
-    , findRealTarget   verbose number        target distribution sanction_list 
+    [ testSingleTarget verbose number target distribution Nothing
+    , findRealTarget   verbose number target distribution sanction_list 
     ]
 
+testTargetVersions :: Bool -> Int -> Map Int Individual -> [(NaturalPerson, 
String, Distribution)] -> TestTree
+testTargetVersions verbose number sanction_list versions =
+  withResource getResource (\_ -> pure ()) $ \ssl ->
+    testGroup ("Test versions of target " ++ show number)
+      [ testCase "Sanction list parsing" $ do
+          list <- ssl
+          assertBool (filepath ++ " should contain only this target") (toList 
list /= [])
+
+      , after AllFinish "Sanction list parsing" $
+          testGroup "Versions:" $
+            map (\(target, title, dist) ->
+                  testGroup ("Test target version " ++ title)
+                    [ testSingleTarget verbose number target dist $ Just ssl
+                    , case (threshold_confidence dist) of
+                        Nothing -> dontFindTarget verbose target sanction_list 
("target " ++ show number)
+                        _       -> findRealTarget verbose number target dist 
sanction_list
+                    ]
+                ) versions
+      ]
+  where filepath    = "target_" ++ show number ++ ".xml"
+        getResource = do ssl <- (individuals . xmlToSSL) <$> 
parseSwissSanctionsList filepath
+                         return ssl 
 
 -- | Find target in sanction list
 findRealTarget :: Bool -> Int -> NaturalPerson -> Distribution -> Map Int 
Individual -> TestTree
@@ -75,17 +97,19 @@ dontFindTarget verbose target sanction_list title =
 
 
 -- | Test if target matches target described in target_SSID.xml
-testSingleTarget :: Bool -> String -> NaturalPerson -> Distribution -> TestTree
-testSingleTarget verbose number target distribution =
-  testCase ("Find target " ++ number ++ " in test file") $ do
-    let filepath = "target_" ++ number ++ ".xml"
-
-    ssl <- (individuals . xmlToSSL) <$> parseSwissSanctionsList filepath
-    assertBool (filepath ++ " should contain only this target") (toList ssl /= 
[])
-
-    let ((ssid,individual):_) = toList ssl
-    assertBool ("SSID should be " ++ number) (ssid == read number)
-
+testSingleTarget :: Bool -> Int -> NaturalPerson -> Distribution -> Maybe (IO 
(Map Int Individual)) -> TestTree
+testSingleTarget verbose number target distribution ssl_target =
+  testCase ("Find target " ++ show number ++ " in test file") $ do
+    ssl <- case ssl_target of
+             Just ssl -> ssl
+             Nothing  -> do let filepath = "target_" ++ show number ++ ".xml"
+                            ssl <- (individuals . xmlToSSL) <$> 
parseSwissSanctionsList filepath
+                            assertBool (filepath ++ " should contain only this 
target") (toList ssl /= [])
+                            return ssl 
+    let ((ssid, individual):_) = toList ssl
+                                           
+
+    assertBool ("SSID should be " ++ show number) (ssid == number)
     let
       address_score = multFloats 150 (checkAddress   (addresses   individual) 
(residential target)) (removeQuality . removeSSID)
       date_score    = multFloats 100 (checkBirthDate (birth_dates individual) 
(birthdate   target)) (removeQuality . removeSSID)
@@ -123,10 +147,14 @@ personTests sanction_list =
                                                                  MAX_SCORE    
150     100  200 125  50          0.75       -}
         [ testTarget False 5144  target_5144     sanction_list $ distribution 
125     100  0   125  0           0.9
         , testTarget False 5266  target_5266     sanction_list $ distribution 
0       0    0   125  0           0.5
-        , testTarget False 49816 target_49816_v1 sanction_list $ distribution 
0       100  0   125  0           0.75
-        , testTarget False 49816 target_49816_v2 sanction_list $ distribution 
0       100  0   0    0           0.75
-        , testTarget False 49816 target_49816_v3 sanction_list $ distribution 
0       0    0   0    0           0.75
-        , testTarget False 49816 target_49816_v4 sanction_list $ distribution 
0       100  0   125  0           0.75
+
+        , testTargetVersions False 49816 sanction_list $
+            [ (target_49816_v1, " v1", distribution 0 100  0 125  0 0.75)
+            , (target_49816_v2, " v2", distribution 0 100  0 0    0 0   )
+            , (target_49816_v3, " v3", distribution 0 0    0 0    0 0   )
+            , (target_49816_v4, " v4", distribution 0 100  0 125  0 0.75)
+            ]
+
         , testTarget False 43462 target_43462    sanction_list $ distribution 
0       100  0   125  0           0.75
         , testTarget False 43616 target_43616    sanction_list $ distribution 
0       0    0   125  0           0.75
         , testTarget False 43641 target_43641    sanction_list $ distribution 
0       100  0   125  0           0.75
@@ -134,11 +162,15 @@ personTests sanction_list =
         , testTarget False 43662 target_43662    sanction_list $ distribution 
0       100  0   125  0           0.75
         , testTarget False 43611 target_43611    sanction_list $ distribution 
0       0    0   125  0           0.75
         , testTarget False 29723 target_29723    sanction_list $ distribution 
0       100  0   125  0           0.75
-        , testTarget False 38925 target_38925_v1 sanction_list $ distribution 
100     0    0   0    0           0.75
-        , testTarget False 38925 target_38925_v2 sanction_list $ distribution 
0       0    0   125  0           0.75
-        , testTarget False 38925 target_38925_v3 sanction_list $ distribution 
0       100  0   0    0           0.75
-        , testTarget False 38925 target_38925_v4 sanction_list $ distribution 
100     0    0   0    0           0.75
-        , testTarget False 38925 target_38925_v5 sanction_list $ distribution 
100     100  0   0    0           0.75
+
+        , testTargetVersions False 38925 sanction_list $
+            [ (target_38925_v1, " v1", distribution 100 0    0 0   0 0.75) -- 
Only address
+            , (target_38925_v2, " v2", distribution 0   0    0 125 0 0   ) -- 
Only name
+            , (target_38925_v3, " v3", distribution 0   100  0 0   0 0   ) -- 
Only birthdate
+            , (target_38925_v4, " v4", distribution 100 0    0 0   0 0.75) -- 
Only address
+            , (target_38925_v5, " v5", distribution 100 100  0 0   0 0.75) -- 
Address + birthdate
+            ]
+
         , testTarget False 68815 target_68815    sanction_list $ distribution 
75      100  0   125  50          0.75
         ]
 

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.