Test Trac #6145

testsuite/tests/ghc-api/Makefile

 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
+
+

testsuite/tests/ghc-api/T6145.hs

+{-# 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

testsuite/tests/ghc-api/T6145.stdout

+True

testsuite/tests/ghc-api/all.T

+test('T6145', [skip_if_fast],
+              run_command,
+              ['$MAKE -s --no-print-directory T6145'])