diff options
Diffstat (limited to 'testsuite/tests')
-rw-r--r-- | testsuite/tests/ghc-api/T4891/T4891.hs | 24 |
1 files changed, 14 insertions, 10 deletions
diff --git a/testsuite/tests/ghc-api/T4891/T4891.hs b/testsuite/tests/ghc-api/T4891/T4891.hs index 4aa4842640..62edae0e78 100644 --- a/testsuite/tests/ghc-api/T4891/T4891.hs +++ b/testsuite/tests/ghc-api/T4891/T4891.hs @@ -5,8 +5,8 @@ import ByteCodeLink import CoreMonad import Data.Array import DataCon -import DebuggerUtils import GHC +import GHC.Exts.Heap import HscTypes import Linker import RtClosureInspect @@ -50,14 +50,18 @@ chaseConstructor :: (GhcMonad m) => HValue -> m () chaseConstructor !hv = do dflags <- getDynFlags liftIO $ putStrLn "=====" - closure <- liftIO $ getClosureData dflags hv - case tipe closure of - Indirection _ -> chaseConstructor (ptrs closure ! 0) - Constr -> do + closure <- liftIO $ getClosureData hv + case closure of + IndClosure{indirectee=ind} -> + (\(Box a) -> chaseConstructor (unsafeCoerce a)) ind + ConstrClosure{} -> do withSession $ \hscEnv -> liftIO $ do - dcName <- dataConInfoPtrToName hscEnv (infoPtr closure) - putStrLn $ "Name: " ++ showPpr dflags dcName - putStrLn $ "OccString: " ++ "'" ++ getOccString dcName ++ "'" - dc <- ioLookupDataCon hscEnv dcName - putStrLn $ "DataCon: " ++ showPpr dflags dc + eDcname <- constrClosToName hscEnv closure + case eDcname of + Left _ -> return () + Right dcName -> do + putStrLn $ "Name: " ++ showPpr dflags dcName + putStrLn $ "OccString: " ++ "'" ++ getOccString dcName ++ "'" + dc <- ioLookupDataCon hscEnv dcName + putStrLn $ "DataCon: " ++ showPpr dflags dc _ -> return () |