Commit 822f996b authored by pcapriotti's avatar pcapriotti

Fix failures in the full testsuite

parent 3afc015b
......@@ -4,7 +4,7 @@ module Main where
import GHC
import MonadUtils ( liftIO )
import DynFlags ( defaultLogAction, defaultFlushOut )
import DynFlags ( defaultFatalMessager, defaultFlushOut )
import Annotations ( AnnTarget(..), CoreAnnTarget )
import Serialized ( deserializeWithData )
import Panic
......@@ -17,7 +17,7 @@ import Data.List
import Data.Function
main :: IO ()
main = defaultErrorHandler defaultLogAction defaultFlushOut
main = defaultErrorHandler defaultFatalMessager defaultFlushOut
$ runGhc (Just cTop) $ do
liftIO $ putStrLn "Initializing Package Database"
dflags <- getSessionDynFlags
......
......@@ -202,12 +202,12 @@ test('Capi_Ctype_002',
['$MAKE -s --no-print-directory Capi_Ctype_002'])
test('ffi_parsing_001',
extra_clean(['ffi_parsing_001_c.o']),
[omit_ways(['ghci']), extra_clean(['ffi_parsing_001_c.o'])],
compile_and_run,
['ffi_parsing_001_c.c'])
test('capi_value',
extra_clean(['capi_value_c.o']),
[omit_ways(['ghci']), extra_clean(['capi_value_c.o'])],
compile_and_run,
['capi_value_c.c'])
......@@ -50,6 +50,7 @@ doit = do
chaseConstructor :: (GhcMonad m) => HValue -> m ()
chaseConstructor !hv = do
dflags <- getDynFlags
liftIO $ putStrLn "====="
closure <- liftIO $ getClosureData hv
case tipe closure of
......@@ -60,12 +61,8 @@ chaseConstructor !hv = do
case eDcname of
Left _ -> return ()
Right dcName -> do
liftIO $ putStrLn $ "Name: " ++ showPpr dcName
liftIO $ putStrLn $ "Name: " ++ showPpr dflags dcName
liftIO $ putStrLn $ "OccString: " ++ "'" ++ getOccString dcName ++ "'"
dc <- tcLookupDataCon dcName
liftIO $ putStrLn $ "DataCon: " ++ showPpr dc
liftIO $ putStrLn $ "DataCon: " ++ showPpr dflags dc
_ -> return ()
initTcForLookup :: HscEnv -> TcM a -> IO a
initTcForLookup hsc_env = liftM (\(msg, mValue) -> fromMaybe (error . show . bagToList . snd $ msg) mValue) . initTc hsc_env HsSrcFile False iNTERACTIVE
......@@ -113,4 +113,6 @@ test('T5363',
[ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ],
compile_and_run, [''])
test('profinline001', extra_ways(['prof']), compile_and_run, [''])
test('profinline001',
[ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ],
compile_and_run, [''])
......@@ -559,6 +559,7 @@ visit_PPRoot (C_Best_1 t_PPS ) x_pw = (x_fmts )
x_frame_1 = (C_F_1 x_pw x_pw)
x_fmts = (eq_best_fmts x_pw x_fmts_1)
(x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_PPS t_PPS x_frame_1
visit_PPS :: PPS -> T_Frame -> (Bool, T_Formats, INT, Integer, Integer)
visit_PPS (C_Above_1 t_PPS_2 t_PPS_3 ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )
where
x_frame_2 = x_frame
......
{-# LANGUAGE ScopedTypeVariables #-}
-- partain: the failure (crashing) was w/ -prof-auto compilation
module Main where
import Control.Exception (IOException, catch)
xreff :: Int -> [String] -> Table -> Int -> String -> String
xreff cc exs stab lineno [] = display (foldl delete stab exs)
xreff cc exs stab lineno ('\n':cs) = xreff cc exs stab (lineno+1) cs
......@@ -61,7 +64,7 @@ dispNos (n:ns) = ' ':(show n ++ dispNos ns)
main = do
input <- getContents
exceptions <- catch (readFile "exceptions") (\ e -> return "")
exceptions <- catch (readFile "exceptions") (\(e :: IOException) -> return "")
putStr (xref (lines exceptions) input)
{- OLD 1.2:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment