Skip to content

Latest commit

 

History

History
91 lines (87 loc) · 4.14 KB

copilot.md

File metadata and controls

91 lines (87 loc) · 4.14 KB
chkErrorPropagation :: [ExeEvent] -> IO ()
chkErrorPropagation evts =
  traverse_ reconcileParents $ threadIds evts
  where
    reconcileParents :: SThreadId -> IO ()
    reconcileParents tid =
      let cpMap' = cpMap tid
          failMap = fails tid
          etMap = evtTypeMap tid
          -- get the parent or if it is a grouping event
          -- get it's paraent Grouping events (Groups and Fixtures) are effectively
          -- ignored in the error propagation
          truParent :: Loc -> Loc
          truParent parentLoc =
            let nxtParent = truParent $ lookupThrow "parent not found in child parent map" cpMap' parentLoc
                parentIsGrouping = isGrouping $ lookupThrow "loc not found in event map" etMap parentLoc
             -- here 
             in (parentLoc == Root)
                  ? Root
                  $ (parentIsGrouping ? nxtParent $ parentLoc)
          trueParentFailure pLoc = failMap M.!? truParent pLoc
       in traverse_
            ( \(chldLoc, pLoc) ->
              -- following 2 lines were cp
                isGrouping (lookupThrow "loc not found in event map" etMap chldLoc)
                  ? pure ()
                  $ failMap M.!? chldLoc
                    & maybe
                      ( -- the child event passed so parent must have passed
                        trueParentFailure pLoc
                          & maybe
                            (pure ())
                            ( error $
                                "Child event passed when parent failed - error should have propagated\nchild\n"
                                  <> ppShow chldLoc
                                  <> "\nparent\n"
                                  <> ppShow (truParent pLoc)
                            )
                      )
                      ( -- the child event failed
                        \case
                          Fail {floc = childLoc, exception = childExcption} ->
                            trueParentFailure pLoc
                              & maybe
                                (pure ())
                                (error $ "Child event failed (not propagated parent failure) when parent failed - parent error should have propagated\n" <> ppShow childLoc)
                          ParentFail {floc = childloc, ploc, exception = childException} ->
                            trueParentFailure pLoc
                              & maybe
                                (error $ "Child event has propagated parent failure when parent has not failed\n" <> ppShow childloc)
                                ( \p ->
                                    let pexcpt = SuiteRuntimeTest.exception p
                                     in chkEq'
                                          ( toS $
                                              "Propagated excption does not equal parent exception for loc:\n"
                                                <> ppShow childloc
                                                <> "\nchild exception\n"
                                                <> ppShow childException
                                                <> "\nparent exception\n"
                                                <> ppShow pexcpt
                                          )
                                          childException
                                          pexcpt
                                )
                      )
            )
            (M.toList cpMap')

    thrdIds = threadIds evts
    evtTypeMap thrdId =
      foldl'
        ( \acc ->
            \case
              Start eet loc _n sti -> eventBelongsToThread thrdId sti eet ? M.insert loc eet acc $ acc
              _ -> acc
        )
        M.empty
        evts
    cpMap = actualChildParentMap evts

    ```

https://www.reddit.com/r/haskell/comments/11eutc9/comment/javi1jm/?utm_source=share&utm_medium=web2x&context=3
```Haskell
  addressTitle = getField @"title" :: AddressElem -> Text
https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0366-no-ambiguous-field-access.rst#migration-strategy