Commit dae50032 authored by Alan Zimmerman's avatar Alan Zimmerman

Remove ghc-api/landmine tests

They take a long time to run, and are effectively superseded by the -ddump-*-ast
tests.
parent 98e494af
landmines
*.hi
*.o
*.run.*
*.normalised
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
{-# 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
{-# 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)
{-# 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
{-# 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
test('landmines', normal, run_command, ['$MAKE -s --no-print-directory landmines'])
{-# 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)
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