Commit 91ea5b4c authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Test Trac #6145

parent 9f3cf8ca
TOP=../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
clean:
rm -f *.o *.hi
T6145: clean
'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T6145
./T6145 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
.PHONY: clean T6145
{-# LANGUAGE PatternGuards #-}
module Main where
import System.IO
import GHC
import MonadUtils
import Outputable
import Bag (filterBag,isEmptyBag)
import System.Directory (removeFile)
import System.Environment( getArgs )
main::IO()
main = do
let c="module Test where\ndata DataT=MkData {name :: String}\n"
writeFile "Test.hs" c
[libdir] <- getArgs
ok<- runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
setSessionDynFlags dflags
let mn =mkModuleName "Test"
addTarget Target { targetId = TargetModule mn, targetAllowObjCode = True, targetContents = Nothing }
load LoadAllTargets
modSum <- getModSummary mn
p <- parseModule modSum
t <- typecheckModule p
d <- desugarModule t
l <- loadModule d
let ts=typecheckedSource l
-- liftIO (putStr (showSDocDebug (ppr ts)))
let fs=filterBag getDataCon ts
return $ not $ isEmptyBag fs
removeFile "Test.hs"
print ok
where
getDataCon (L _ (AbsBinds { abs_binds = bs }))
= not (isEmptyBag (filterBag getDataCon bs))
getDataCon (L l (f@FunBind {}))
| (MatchGroup (m:_) _)<-fun_matches f,
(L _ (c@ConPatOut{}):_)<-hsLMatchPats m,
(L l _)<-pat_con c
= isGoodSrcSpan l -- Check that the source location is a good one
getDataCon _
= False
test('T6145', [skip_if_fast],
run_command,
['$MAKE -s --no-print-directory T6145'])
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