Unload loaded code if 'resolveObjs' fail.

Keeping the erroneous code in memory will leave the system in an unusable state.
This commit is contained in:
lemmih 2005-08-24 18:43:46 +00:00
parent fc1f9c698a
commit 5d2b4db2a8

View File

@ -113,7 +113,7 @@ load obj incpaths pkgconfs sym = do
m' <- loadObject obj (Object (mi_module hif))
let m = m' { iface = hif }
resolveObjs
resolveObjs (mapM_ unloadAll (m:moduleDeps))
#if DEBUG
putStrLn " ... done" >> hFlush stdout
@ -340,7 +340,7 @@ reload m@(Module{path = p, iface = hi}) sym = do
m_ <- loadObject p (Object $ mi_module hi) -- load object at path p
let m' = m_ { iface = hi }
resolveObjs
resolveObjs (unloadAll m)
#if DEBUG
putStrLn "done" >> hFlush stdout
#endif
@ -466,11 +466,10 @@ loadRawObject obj = loadObject obj (Object k)
--
-- | Resolve (link) the modules loaded by the 'loadObject' function.
--
resolveObjs :: IO ()
resolveObjs = do
r <- c_resolveObjs
when (not r) $
panic $ "resolveObjs failed with <<" ++ show r ++ ">>"
resolveObjs :: IO a -> IO ()
resolveObjs unloadLoaded
= do r <- c_resolveObjs
when (not r) $ unloadLoaded >> panic "resolvedObjs failed."
-- | Unload a module
@ -624,7 +623,7 @@ loadDepends obj incpaths = do
when (not (null ps')) $
putStr " ... linking ... " >> hFlush stdout
#endif
resolveObjs
resolveObjs (mapM_ unloadPackage ps')
#if DEBUG
when (not (null ps')) $ putStrLn "done"
putStr "Loading object"