Improve the desugaring of -XStrict
[ghc.git] / testsuite / tests / ghc-api / T6145.hs
1 {-# LANGUAGE PatternGuards #-}
2 module Main where
3
4 import System.IO
5 import GHC
6 import MonadUtils
7 import Outputable
8 import Bag (filterBag,isEmptyBag)
9 import System.Directory (removeFile)
10 import System.Environment( getArgs )
11
12 main::IO()
13 main = do
14 let c="module Test where\ndata DataT=MkData {name :: String}\n"
15 writeFile "Test.hs" c
16 [libdir] <- getArgs
17 ok<- runGhc (Just libdir) $ do
18 dflags <- getSessionDynFlags
19 setSessionDynFlags dflags
20 let mn =mkModuleName "Test"
21 addTarget Target { targetId = TargetModule mn, targetAllowObjCode = True, targetContents = Nothing }
22 load LoadAllTargets
23 modSum <- getModSummary mn
24 p <- parseModule modSum
25 t <- typecheckModule p
26 d <- desugarModule t
27 l <- loadModule d
28 let ts=typecheckedSource l
29 -- liftIO (putStr (showSDocDebug (ppr ts)))
30 let fs=filterBag isDataCon ts
31 return $ not $ isEmptyBag fs
32 removeFile "Test.hs"
33 print ok
34 where
35 isDataCon (L _ (AbsBinds { abs_binds = bs }))
36 = not (isEmptyBag (filterBag isDataCon bs))
37 isDataCon (L l (f@FunBind {}))
38 | (MG (L _ (m:_)) _ _ _) <- fun_matches f,
39 (L _ (c@ConPatOut{}):_)<-hsLMatchPats m,
40 (L l _)<-pat_con c
41 = isGoodSrcSpan l -- Check that the source location is a good one
42 isDataCon _
43 = False