diff options
-rw-r--r-- | testsuite/tests/ghc-api/landmines/.gitignore | 5 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/landmines/Makefile | 13 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/landmines/MineFixity.hs | 23 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/landmines/MineKind.hs | 26 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/landmines/MineNames.hs | 22 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/landmines/MineType.hs | 21 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/landmines/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/landmines/landmines.hs | 90 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/landmines/landmines.stdout | 4 |
9 files changed, 0 insertions, 206 deletions
diff --git a/testsuite/tests/ghc-api/landmines/.gitignore b/testsuite/tests/ghc-api/landmines/.gitignore deleted file mode 100644 index 1452e78bbd..0000000000 --- a/testsuite/tests/ghc-api/landmines/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -landmines -*.hi -*.o -*.run.* -*.normalised diff --git a/testsuite/tests/ghc-api/landmines/Makefile b/testsuite/tests/ghc-api/landmines/Makefile deleted file mode 100644 index c727b95e66..0000000000 --- a/testsuite/tests/ghc-api/landmines/Makefile +++ /dev/null @@ -1,13 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - -clean: - rm -f *.o *.hi - -landmines: clean - '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc landmines - ./landmines "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" - - -.PHONY: clean landmines diff --git a/testsuite/tests/ghc-api/landmines/MineFixity.hs b/testsuite/tests/ghc-api/landmines/MineFixity.hs deleted file mode 100644 index a735ee6aaf..0000000000 --- a/testsuite/tests/ghc-api/landmines/MineFixity.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} -{- - -Exercising avoidance of known landmines. - -We need one each of - - PostTc id Kind - PostTc id Type - - PostRn id Fixity - PostRn id NameSet - - --} -module MineFixity where - -infixl 3 `foo` - -foo = undefined diff --git a/testsuite/tests/ghc-api/landmines/MineKind.hs b/testsuite/tests/ghc-api/landmines/MineKind.hs deleted file mode 100644 index c97a996c66..0000000000 --- a/testsuite/tests/ghc-api/landmines/MineKind.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} -{- - -Exercising avoidance of known landmines. - -We need one each of - - PostTc id Kind - PostTc id Type - - PostRn id Fixity - PostRn id NameSet - - --} -module MineKind where - -data HList :: [*] -> * where - HNil :: HList '[] - HCons :: a -> HList t -> HList (a ': t) - -data Tuple :: (*,*) -> * where - Tuple :: a -> b -> Tuple '(a,b) diff --git a/testsuite/tests/ghc-api/landmines/MineNames.hs b/testsuite/tests/ghc-api/landmines/MineNames.hs deleted file mode 100644 index af5362fc37..0000000000 --- a/testsuite/tests/ghc-api/landmines/MineNames.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} -{- - -Exercising avoidance of known landmines. - -We need one each of - - PostTc id Kind - PostTc id Type - - PostRn id Fixity - PostRn id NameSet - - --} -module MineNames where - -foo :: Int -foo = 1 diff --git a/testsuite/tests/ghc-api/landmines/MineType.hs b/testsuite/tests/ghc-api/landmines/MineType.hs deleted file mode 100644 index 142d7c9af7..0000000000 --- a/testsuite/tests/ghc-api/landmines/MineType.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} -{- - -Exercising avoidance of known landmines. - -We need one each of - - PostTc id Kind - PostTc id Type - - PostRn id Fixity - PostRn id NameSet - - --} -module MineType where - -foo = undefined diff --git a/testsuite/tests/ghc-api/landmines/all.T b/testsuite/tests/ghc-api/landmines/all.T deleted file mode 100644 index b03a97f0ae..0000000000 --- a/testsuite/tests/ghc-api/landmines/all.T +++ /dev/null @@ -1,2 +0,0 @@ -test('landmines', normal, run_command, ['$MAKE -s --no-print-directory landmines']) - diff --git a/testsuite/tests/ghc-api/landmines/landmines.hs b/testsuite/tests/ghc-api/landmines/landmines.hs deleted file mode 100644 index 9b058fa8a8..0000000000 --- a/testsuite/tests/ghc-api/landmines/landmines.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE RankNTypes #-} - --- This program must be called with GHC's libdir as the single command line --- argument. -module Main where - --- import Data.Generics -import Data.Data -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 - [libdir] <- getArgs - testOneFile libdir "MineFixity" - testOneFile libdir "MineKind" - testOneFile libdir "MineNames" - testOneFile libdir "MineType" - - -testOneFile libdir fileName = do - (p,r,ts) <- runGhc (Just libdir) $ do - dflags <- getSessionDynFlags - setSessionDynFlags dflags - let mn =mkModuleName fileName - 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 - r =renamedSource l - -- liftIO (putStr (showSDocDebug (ppr ts))) - return (pm_parsed_source p,r,ts) - let pCount = gq p - rCount = gq r - tsCount = gq ts - - print (pCount,rCount,tsCount) - where - gq ast = length $ everything (++) ([] `mkQ` worker) ast - - worker (s@(RealSrcSpan _)) = [s] - worker _ = [] - --- --------------------------------------------------------------------- - --- Copied from syb for the test - - --- | Generic queries of type \"r\", --- i.e., take any \"a\" and return an \"r\" --- -type GenericQ r = forall a. Data a => a -> r - - --- | Make a generic query; --- start from a type-specific case; --- return a constant otherwise --- -mkQ :: ( Typeable a - , Typeable b - ) - => r - -> (b -> r) - -> a - -> r -(r `mkQ` br) a = case cast a of - Just b -> br b - Nothing -> r - - - --- | Summarise all nodes in top-down, left-to-right order -everything :: (r -> r -> r) -> GenericQ r -> GenericQ r - --- Apply f to x to summarise top-level node; --- use gmapQ to recurse into immediate subterms; --- use ordinary foldl to reduce list of intermediate results - -everything k f x = foldl k (f x) (gmapQ (everything k f) x) diff --git a/testsuite/tests/ghc-api/landmines/landmines.stdout b/testsuite/tests/ghc-api/landmines/landmines.stdout deleted file mode 100644 index 61ddb374a7..0000000000 --- a/testsuite/tests/ghc-api/landmines/landmines.stdout +++ /dev/null @@ -1,4 +0,0 @@ -(12,12,8) -(93,63,0) -(15,13,8) -(10,10,8) |