[commit: testsuite] master: Test Trac #6145 (f1a7042)

[Simon Peyton Jones]

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/f1a704268088d9a8816c67dff730e2538ad12963

>---------------------------------------------------------------

commit f1a704268088d9a8816c67dff730e2538ad12963
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Jun 7 15:41:19 2012 +0100

    Test Trac #6145

>---------------------------------------------------------------

 tests/ghc-api/Makefile                             |   11 +++++
 tests/ghc-api/T6145.hs                             |   43 ++++++++++++++++++++
 .../cgrun033.stdout => ghc-api/T6145.stdout}       |    0 
 tests/ghc-api/all.T                                |    3 +
 4 files changed, 57 insertions(+), 0 deletions(-)

diff --git a/tests/ghc-api/Makefile b/tests/ghc-api/Makefile
index 9a36a1c..57ba15c 100644
--- a/tests/ghc-api/Makefile
+++ b/tests/ghc-api/Makefile
@@ -1,3 +1,14 @@
 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
+
+
diff --git a/tests/ghc-api/T6145.hs b/tests/ghc-api/T6145.hs
new file mode 100644
index 0000000..42fc93b
--- /dev/null
+++ b/tests/ghc-api/T6145.hs
@@ -0,0 +1,43 @@
+{-# 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 at FunBind {}))
+        | (MatchGroup (m:_) _)<-fun_matches f,
+          (L _ (c at ConPatOut{}):_)<-hsLMatchPats m,
+          (L l _)<-pat_con c
+        = isGoodSrcSpan l       -- Check that the source location is a good one
+      getDataCon _ 
+        = False
diff --git a/tests/codeGen/should_run/cgrun033.stdout b/tests/ghc-api/T6145.stdout
similarity index 100%
copy from tests/codeGen/should_run/cgrun033.stdout
copy to tests/ghc-api/T6145.stdout
diff --git a/tests/ghc-api/all.T b/tests/ghc-api/all.T
new file mode 100644
index 0000000..62cd1b5
--- /dev/null
+++ b/tests/ghc-api/all.T
@@ -0,0 +1,3 @@
+test('T6145', [skip_if_fast],
+              run_command,
+              ['$MAKE -s --no-print-directory T6145'])