fix_integrity: fixed name, added tests

src/NITTA/Model/IntegrityCheck.hs

@@ -4,7 +4,7 @@
 
 {- |
 Module      : NITTA.Model.IntegrityCheck
-Description : Tests vertical relations in PU
+Description : Module for checking model description consistency
 Copyright   : (c) Artyom Kostyuchik, 2021
 License     : BSD3
 Maintainer  : [email protected]
@@ -22,11 +22,10 @@ import NITTA.Utils
 import Safe
 
 checkIntegrity pu =
-    let pr = process pu
-        getInterMap =
+    let getInterMap =
             M.fromList
                 [ (pID, f)
-                | step@Step{pID, pDesc} <- steps pr
+                | step@Step{pID, pDesc} <- steps $ process pu
                 , isFB step
                 , f <- case pDesc of
                     (FStep f) -> [f]
@@ -36,7 +35,7 @@ checkIntegrity pu =
             M.fromListWith (++) $
                 concat
                     [ concatMap (\v -> [(v, [(pID, ep)])]) $ variables ep
-                    | step@Step{pID, pDesc} <- steps pr
+                    | step@Step{pID, pDesc} <- steps $ process pu
                     , isEndpoint step
                     , ep <- case pDesc of
                         (EndpointRoleStep e) -> [e]
@@ -45,14 +44,12 @@ checkIntegrity pu =
         getInstrMap =
             M.fromList
                 [ (pID, pDesc)
-                | Step{pID, pDesc} <- steps pr
+                | Step{pID, pDesc} <- steps $ process pu
                 , isInstruction pDesc
                 ]
      in and
-            [ checkEndpointToIntermidiateRelation getEpMap getInterMap pr
-            , checkInstructionToEndpointRelation getInstrMap getEpMap pr
-            , True
-            , True
+            [ checkEndpointToIntermidiateRelation getEpMap getInterMap $ process pu
+            , checkInstructionToEndpointRelation getInstrMap getEpMap $ process pu
             ]
 
 checkEndpointToIntermidiateRelation eps ifs pr = S.isSubsetOf makeRelationList rels

src/NITTA/Model/ProcessorUnits/Broken.hs

@@ -26,7 +26,7 @@ module NITTA.Model.ProcessorUnits.Broken (
     IOPorts (..),
 ) where
 
-import Control.Monad (when)
+import Control.Monad
 import Data.Default
 import Data.List (find, (\\))
 import Data.Set (elems, fromList, member)
@@ -64,8 +64,9 @@ data Broken v x t = Broken
     , -- |lost source endpoint due synthesis
       lostEndpointSource :: Bool
     , wrongAttr :: Bool
-    , -- | lost vertical relation
-      lostVerticalRelation :: Bool
+    , lostFunctionRelation :: Bool
+    , lostEndpointRelation :: Bool
+    , lostInstructionRelation :: Bool
     , unknownDataOut :: Bool
     }
 
@@ -119,33 +120,46 @@ instance (VarValTime v x t) => EndpointProblem (Broken v x t) v t where
         | not $ null remain = concatMap (endpointOptions . execution pu) $ tail remain
     endpointOptions pu@Broken{remain} = concatMap (endpointOptions . execution pu) remain
 
-    endpointDecision pu@Broken{targets = [v], currentWorkEndpoints, wrongControlOnPush, lostVerticalRelation} d@EndpointSt{epRole = Target v', epAt}
-        | v == v'
-          , let (newEndpoints, process_') = runSchedule pu $ do
-                    updateTick (sup epAt)
-                    let ins = scheduleInstruction (shiftI (if wrongControlOnPush then 1 else 0) epAt) Load
-                    let ins' = if lostVerticalRelation then fmap (const []) ins else ins
-                    scheduleEndpoint d ins' =
-            pu
-                { process_ = process_'
-                , targets = []
-                , currentWorkEndpoints = newEndpoints ++ currentWorkEndpoints
-                , doneAt = Just $ sup epAt + 3
-                }
     endpointDecision
-        pu@Broken{targets = [], sources, doneAt, currentWork = Just (a, f), currentWorkEndpoints, wrongControlOnPull, lostVerticalRelation}
+        pu@Broken{targets = [v], currentWorkEndpoints, wrongControlOnPush, lostInstructionRelation, lostEndpointRelation}
+        d@EndpointSt{epRole = Target v', epAt}
+            | v == v'
+              , let (newEndpoints, process_') = runSchedule pu $ do
+                        updateTick (sup epAt)
+                        let ins =
+                                if lostInstructionRelation
+                                    then return []
+                                    else scheduleInstruction (shiftI (if wrongControlOnPush then 1 else 0) epAt) Load
+                        if lostEndpointRelation then return [] else scheduleEndpoint d ins =
+                pu
+                    { process_ = process_'
+                    , targets = []
+                    , currentWorkEndpoints = newEndpoints ++ currentWorkEndpoints
+                    , doneAt = Just $ sup epAt + 3
+                    }
+    endpointDecision
+        pu@Broken{targets = [], sources, doneAt, currentWork = Just (a, f), currentWorkEndpoints, wrongControlOnPull, lostInstructionRelation, lostEndpointRelation, lostFunctionRelation}
         d@EndpointSt{epRole = Source v, epAt}
             | not $ null sources
               , let sources' = sources \\ elems v
               , sources' /= sources
               , let (newEndpoints, process_') = runSchedule pu $ do
-                        let ins = scheduleInstruction (shiftI (if wrongControlOnPull then 0 else -1) epAt) Out
-                        let res = scheduleEndpoint d $ if lostVerticalRelation then fmap (const []) ins else ins
+                        let ins =
+                                if lostInstructionRelation
+                                    then return []
+                                    else scheduleInstruction (shiftI (if wrongControlOnPull then 0 else -1) epAt) Out
+                        let res =
+                                if lostEndpointRelation
+                                    then return []
+                                    else scheduleEndpoint d ins
                         endpoints <- res
                         when (null sources') $ do
                             high <- scheduleFunction (a ... sup epAt) f
+                            --if lostFunctionRelation
+                            --    then return []
+                            --   else
                             let low = endpoints ++ currentWorkEndpoints
-                            uncurry establishVerticalRelations $ if lostVerticalRelation then ([], []) else (high, low)
+                            unless lostFunctionRelation $ uncurry establishVerticalRelations (high, low)
                         updateTick (sup epAt + 1)
                         return endpoints =
                 pu
@@ -207,7 +221,9 @@ instance (Time t) => Default (Broken v x t) where
             , lostEndpointTarget = False
             , lostEndpointSource = False
             , wrongAttr = False
-            , lostVerticalRelation = False
+            , lostFunctionRelation = False
+            , lostEndpointRelation = False
+            , lostInstructionRelation = False
             , unknownDataOut = False
             }
 

src/NITTA/Utils.hs

@@ -35,7 +35,6 @@ module NITTA.Utils (
     stepsInterval,
     relatedEndpoints,
     isFB,
-    getFBs,
     isEndpoint,
     isInstruction,
     module NITTA.Utils.Base,
@@ -112,8 +111,6 @@ isFB s = isJust $ getFB s
 getFB Step{pDesc} | FStep fb <- descent pDesc = Just fb
 getFB _ = Nothing
 
-getFBs p = mapMaybe getFB $ sortOn stepStart $ steps p
-
 isEndpoint ep = isJust $ getEndpoint ep
 
 getEndpoint Step{pDesc} | EndpointRoleStep role <- descent pDesc = Just role

test/NITTA/Model/ProcessorUnits/Broken/Tests.hs

@@ -115,11 +115,28 @@ tests =
             ]
         , testGroup
             "broken relations integrity check"
-            [ expectFail $ finitePUSynthesisProp "finitePUSynthesisProp lost relations" u{lostVerticalRelation = True} fsGen
-            [ finitePUSynthesisProp "finitePUSynthesisProp relation positive test" u{lostVerticalRelation = False} fsGen
-            , puCoSimProp "puCoSimProp relation positive test" u{lostVerticalRelation = False} fsGen
-            , expectFail $ finitePUSynthesisProp "finitePUSynthesisProp lost relations" u{lostVerticalRelation = True} fsGen
-            , expectFail $ puCoSimProp "puCoSimProp lost relations" u{lostVerticalRelation = True} fsGen
+            [ finitePUSynthesisProp "finitePUSynthesisProp relation positive test" u fsGen
+            , puCoSimProp "puCoSimProp relation positive test" u fsGen
+            , --- TODO fix case when we have lost Intstruction but integrityCheck is OK
+              expectFail $ finitePUSynthesisProp "finitePUSynthesisProp lost instr and ep" u{lostInstructionRelation = True, lostEndpointRelation = True} fsGen
+            , expectFail $ finitePUSynthesisProp "finitePUSynthesisProp lost Function" u{lostFunctionRelation = True} fsGen
+            , expectFail $ finitePUSynthesisProp "finitePUSynthesisProp lost Endpoints" u{lostEndpointRelation = True} fsGen
+            , expectFail $ finitePUSynthesisProp "finitePUSynthesisProp lost Instruction" u{lostInstructionRelation = True} fsGen
+            , expectFail $ puCoSimProp "puCoSimProp lost Function" u{lostFunctionRelation = True} fsGen
+            , expectFail $ puCoSimProp "puCoSimProp lost Endpoints" u{lostEndpointRelation = True} fsGen
+            , expectFail $ puCoSimProp "puCoSimProp lost Instruction" u{lostInstructionRelation = True} fsGen
+            ]
+        , testGroup
+            --"broken relations coSimTest"
+            "broken relations integrity check"
+            [ nittaCoSimTestCase "nittaCoSimTestCase positive test" (maBroken u) alg
+            , typedLuaTestCase (maBroken def) pInt "typedLuaTestCase positive test" lua
+            , expectFail $ nittaCoSimTestCase "nittaCoSimTestCase lost Function" (maBroken u{lostFunctionRelation = True}) alg
+            , expectFail $ nittaCoSimTestCase "nittaCoSimTestCase lost Endpoints" (maBroken u{lostEndpointRelation = True}) alg
+            , expectFail $ nittaCoSimTestCase "nittaCoSimTestCase lost Instruction" (maBroken u{lostInstructionRelation = True}) alg
+            , expectFail $ typedLuaTestCase (maBroken def{lostFunctionRelation = True}) pInt "typedLuaTestCase lost Function" lua
+            , expectFail $ typedLuaTestCase (maBroken def{lostEndpointRelation = True}) pInt "typedLuaTestCase lost Endpoints" lua
+            , expectFail $ typedLuaTestCase (maBroken def{lostInstructionRelation = True}) pInt "typedLuaTestCase lost Instruction" lua
             ]
         ]
     where