diff options
author | GHC GitLab CI <ghc-ci@gitlab-haskell.org> | 2021-03-23 08:32:31 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-03-25 04:53:16 -0400 |
commit | 1350a5cd730f1cbbe306b849def26bfcd119c103 (patch) | |
tree | 45c8b4ef2cd4b09d6f9a24da905a1be5ff5ee616 /testsuite/tests/ghc-api | |
parent | 0029df2bd52aa7f93e2254a369428e4261e5d3ae (diff) | |
download | haskell-1350a5cd730f1cbbe306b849def26bfcd119c103.tar.gz |
EPA : Remove ApiAnn from ParsedModule
All the comments are now captured in the AST, there is no need for a
side-channel structure for them.
Diffstat (limited to 'testsuite/tests/ghc-api')
-rw-r--r-- | testsuite/tests/ghc-api/annotations/.gitignore | 26 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/CheckUtils.hs | 118 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/CommentsTest.hs | 15 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/InTreeAnnotations1.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr | 521 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/Makefile | 32 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/all.T | 4 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/bundle-export.stdout | 37 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/comments.hs | 72 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/comments.stdout | 17 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/exampleTest.stdout | 88 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/stringSource.hs | 146 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/t11430.hs | 133 |
13 files changed, 0 insertions, 1217 deletions
diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore deleted file mode 100644 index 320a756e5c..0000000000 --- a/testsuite/tests/ghc-api/annotations/.gitignore +++ /dev/null @@ -1,26 +0,0 @@ -annotations -parseTree -comments -exampleTest -listcomps -boolFormula -t10255 -t10268 -t10269 -t10278 -t10280 -t10307 -t10309 -t10312 -t10354 -t10357 -t10358 -t10396 -t10399 -t11430 -load-main -stringSource -*.hi -*.o -*.run.* -*.normalised diff --git a/testsuite/tests/ghc-api/annotations/CheckUtils.hs b/testsuite/tests/ghc-api/annotations/CheckUtils.hs deleted file mode 100644 index d3a2b3d80e..0000000000 --- a/testsuite/tests/ghc-api/annotations/CheckUtils.hs +++ /dev/null @@ -1,118 +0,0 @@ -{-# LANGUAGE RankNTypes #-} - --- This program must be called with GHC's libdir and the file to be checked as --- the command line arguments. -module CheckUtils where - -import Data.Data -import Data.List -import System.IO -import GHC -import GHC.Types.Basic -import GHC.Driver.Session -import GHC.Driver.Ppr -import GHC.Utils.Monad -import GHC.Utils.Outputable -import GHC.Parser.Annotation -import GHC.Data.Bag (filterBag,isEmptyBag) -import System.Directory (removeFile) -import System.Environment( getArgs ) -import qualified Data.Map as Map -import qualified Data.Set as Set -import Data.Dynamic ( fromDynamic,Dynamic ) - -_main::IO() -_main = do - [libdir,fileName] <- getArgs - testOneFile libdir fileName - -testOneFile libdir fileName = do - ((anns,cs),p) <- 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 - return (pm_annotations p,p) - - let spans = Set.fromList $ getAllSrcSpans (pm_parsed_source p) - - problems = filter (\(s,a) -> not (Set.member s spans)) - $ getAnnSrcSpans (anns,cs) - - exploded = [((kw,ss),[anchor]) - | ((anchor,kw),sss) <- Map.toList anns,ss <- sss] - - exploded' = Map.toList $ Map.fromListWith (++) exploded - - problems' = filter (\(_,anchors) - -> not (any (\a -> Set.member a spans) anchors)) - exploded' - - putStrLn "---Problems---------------------" - putStrLn (intercalate "\n" [showAnns $ Map.fromList $ map snd problems]) - putStrLn "---Problems'--------------------" - putStrLn (intercalate "\n" [pp $ Map.fromList $ map fst problems']) - putStrLn "--------------------------------" - putStrLn (intercalate "\n" [showAnns anns]) - - where - getAnnSrcSpans :: ApiAnns -> [(SrcSpan,(ApiAnnKey,[SrcSpan]))] - getAnnSrcSpans (anns,_) = map (\a@((ss,_),_) -> (ss,a)) $ Map.toList anns - - getAllSrcSpans :: (Data t) => t -> [SrcSpan] - getAllSrcSpans ast = everything (++) ([] `mkQ` getSrcSpan) ast - where - getSrcSpan :: SrcSpan -> [SrcSpan] - getSrcSpan ss = [ss] - - -showAnns anns = "[\n" ++ (intercalate "\n" - $ map (\((s,k),v) - -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n")) - $ Map.toList anns) - ++ "]\n" - -pp a = showPprUnsafe a - - --- --------------------------------------------------------------------- - --- 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/annotations/CommentsTest.hs b/testsuite/tests/ghc-api/annotations/CommentsTest.hs deleted file mode 100644 index c6cf79c5da..0000000000 --- a/testsuite/tests/ghc-api/annotations/CommentsTest.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE DeriveFoldable #-} -module CommentsTest (foo) where -{- -An opening comment - {- with a nested one -} - {-# nested PRAGMA #-} --} - -import qualified Data.List as DL - --- | The function @foo@ does blah -foo = let - a = 1 - b = 2 -- value 2 - in a + b diff --git a/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.hs b/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.hs deleted file mode 100644 index c454b0a237..0000000000 --- a/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE ViewPatterns, BangPatterns #-} -module InTreeAnnotations1 where - -foo a@(_,_) !"a" ~x = undefined - -data T = MkT { x,y :: Int } - -f (MkT { x = !v, y = negate -> w }) = v + w diff --git a/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr b/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr deleted file mode 100644 index 42e3143635..0000000000 --- a/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr +++ /dev/null @@ -1,521 +0,0 @@ - -==================== Parser AST ==================== - -(L - { InTreeAnnotations1.hs:1:1 } - (HsModule - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddApiAnn AnnModule (AR { InTreeAnnotations1.hs:2:1-6 })) - ,(AddApiAnn AnnWhere (AR { InTreeAnnotations1.hs:2:27-31 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) - [] - [])) - (AnnCommentsBalanced - [] - [(L - (Anchor - { InTreeAnnotations1.hs:9:1 } - (UnchangedAnchor)) - (AnnComment - (AnnEofComment) - { InTreeAnnotations1.hs:9:1 }))])) - (VirtualBraces - (1)) - (Just - (L - { InTreeAnnotations1.hs:2:8-25 } - {ModuleName: InTreeAnnotations1})) - (Nothing) - [] - [(L - (SrcSpanAnn (ApiAnn - (Anchor - { InTreeAnnotations1.hs:4:1-31 } - (UnchangedAnchor)) - (AnnListItem - []) - (AnnComments - [])) { InTreeAnnotations1.hs:4:1-31 }) - (ValD - (NoExtField) - (FunBind - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:1-3 }) - (Unqual - {OccName: foo})) - (MG - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:1-31 }) - [(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:1-31 }) - (Match - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:4:1-31 } - (UnchangedAnchor)) - [] - (AnnComments - [])) - (FunRhs - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:1-3 }) - (Unqual - {OccName: foo})) - (Prefix) - (NoSrcStrict)) - [(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:5-11 }) - (AsPat - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:4:5-11 } - (UnchangedAnchor)) - [(AddApiAnn AnnAt (AR { InTreeAnnotations1.hs:4:6 }))] - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:5 }) - (Unqual - {OccName: a})) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:7-11 }) - (TuplePat - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:4:7-11 } - (UnchangedAnchor)) - [(AddApiAnn AnnOpenP (AR { InTreeAnnotations1.hs:4:7 })) - ,(AddApiAnn AnnCloseP (AR { InTreeAnnotations1.hs:4:11 }))] - (AnnComments - [])) - [(L - (SrcSpanAnn (ApiAnn - (Anchor - { InTreeAnnotations1.hs:4:8 } - (UnchangedAnchor)) - (AnnListItem - [(AddCommaAnn - (AR { InTreeAnnotations1.hs:4:9 }))]) - (AnnComments - [])) { InTreeAnnotations1.hs:4:8 }) - (WildPat - (NoExtField))) - ,(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:10 }) - (WildPat - (NoExtField)))] - (Boxed))))) - ,(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:13-16 }) - (BangPat - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:4:13-16 } - (UnchangedAnchor)) - [(AddApiAnn AnnBang (AR { InTreeAnnotations1.hs:4:13 }))] - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:14-16 }) - (LitPat - (NoExtField) - (HsString - (SourceText "a") - {FastString: "a"}))))) - ,(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:18-19 }) - (LazyPat - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:4:18-19 } - (UnchangedAnchor)) - [(AddApiAnn AnnTilde (AR { InTreeAnnotations1.hs:4:18 }))] - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:19 }) - (VarPat - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:19 }) - (Unqual - {OccName: x}))))))] - (GRHSs - (NoExtField) - [(L - { InTreeAnnotations1.hs:4:21-31 } - (GRHS - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:4:21-31 } - (UnchangedAnchor)) - (GrhsAnn - (Nothing) - (AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:4:21 }))) - (AnnComments - [])) - [] - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:23-31 }) - (HsVar - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:23-31 }) - (Unqual - {OccName: undefined}))))))] - (EmptyLocalBinds - (NoExtField)))))]) - (FromSource)) - []))) - ,(L - (SrcSpanAnn (ApiAnn - (Anchor - { InTreeAnnotations1.hs:6:1-27 } - (UnchangedAnchor)) - (AnnListItem - []) - (AnnComments - [])) { InTreeAnnotations1.hs:6:1-27 }) - (TyClD - (NoExtField) - (DataDecl - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:6:1-27 } - (UnchangedAnchor)) - [(AddApiAnn AnnData (AR { InTreeAnnotations1.hs:6:1-4 })) - ,(AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:6:8 }))] - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:6 }) - (Unqual - {OccName: T})) - (HsQTvs - (NoExtField) - []) - (Prefix) - (HsDataDefn - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:6:1-27 } - (UnchangedAnchor)) - [(AddApiAnn AnnData (AR { InTreeAnnotations1.hs:6:1-4 })) - ,(AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:6:8 }))] - (AnnComments - [])) - (DataType) - (Nothing) - (Nothing) - (Nothing) - [(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:10-27 }) - (ConDeclH98 - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:6:10-27 } - (UnchangedAnchor)) - [] - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:10-12 }) - (Unqual - {OccName: MkT})) - (False) - [] - (Nothing) - (RecCon - (L - (SrcSpanAnn (ApiAnn - (Anchor - { InTreeAnnotations1.hs:6:14 } - (UnchangedAnchor)) - (AnnList - (Just - (Anchor - { InTreeAnnotations1.hs:6:16-25 } - (UnchangedAnchor))) - (Just - (AddApiAnn AnnOpenC (AR { InTreeAnnotations1.hs:6:14 }))) - (Just - (AddApiAnn AnnCloseC (AR { InTreeAnnotations1.hs:6:27 }))) - [] - []) - (AnnComments - [])) { InTreeAnnotations1.hs:6:14-27 }) - [(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:16-25 }) - (ConDeclField - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:6:16-18 } - (UnchangedAnchor)) - [(AddApiAnn AnnDcolon (AR { InTreeAnnotations1.hs:6:20-21 }))] - (AnnComments - [])) - [(L - { InTreeAnnotations1.hs:6:16 } - (FieldOcc - (NoExtField) - (L - (SrcSpanAnn (ApiAnn - (Anchor - { InTreeAnnotations1.hs:6:16 } - (UnchangedAnchor)) - (NameAnnTrailing - [(AddCommaAnn - (AR { InTreeAnnotations1.hs:6:17 }))]) - (AnnComments - [])) { InTreeAnnotations1.hs:6:16 }) - (Unqual - {OccName: x})))) - ,(L - { InTreeAnnotations1.hs:6:18 } - (FieldOcc - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:18 }) - (Unqual - {OccName: y}))))] - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:23-25 }) - (HsTyVar - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:6:23-25 } - (UnchangedAnchor)) - [] - (AnnComments - [])) - (NotPromoted) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:23-25 }) - (Unqual - {OccName: Int})))) - (Nothing)))])) - (Nothing)))] - [])))) - ,(L - (SrcSpanAnn (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:1-43 } - (UnchangedAnchor)) - (AnnListItem - []) - (AnnComments - [])) { InTreeAnnotations1.hs:8:1-43 }) - (ValD - (NoExtField) - (FunBind - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:1 }) - (Unqual - {OccName: f})) - (MG - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:1-43 }) - [(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:1-43 }) - (Match - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:1-43 } - (UnchangedAnchor)) - [] - (AnnComments - [])) - (FunRhs - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:1 }) - (Unqual - {OccName: f})) - (Prefix) - (NoSrcStrict)) - [(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:3-35 }) - (ParPat - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:3-35 } - (UnchangedAnchor)) - (AnnParen - (AnnParens) - (AR { InTreeAnnotations1.hs:8:3 }) - (AR { InTreeAnnotations1.hs:8:35 })) - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:4-34 }) - (ConPat - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:4-34 } - (UnchangedAnchor)) - [(AddApiAnn AnnOpenC (AR { InTreeAnnotations1.hs:8:8 })) - ,(AddApiAnn AnnCloseC (AR { InTreeAnnotations1.hs:8:34 }))] - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:4-6 }) - (Unqual - {OccName: MkT})) - (RecCon - (HsRecFields - [(L - (SrcSpanAnn (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:10-15 } - (UnchangedAnchor)) - (AnnListItem - [(AddCommaAnn - (AR { InTreeAnnotations1.hs:8:16 }))]) - (AnnComments - [])) { InTreeAnnotations1.hs:8:10-15 }) - (HsRecField - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:10 } - (UnchangedAnchor)) - [(AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:8:12 }))] - (AnnComments - [])) - (L - { InTreeAnnotations1.hs:8:10 } - (FieldOcc - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:10 }) - (Unqual - {OccName: x})))) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:14-15 }) - (BangPat - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:14-15 } - (UnchangedAnchor)) - [(AddApiAnn AnnBang (AR { InTreeAnnotations1.hs:8:14 }))] - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:15 }) - (VarPat - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:15 }) - (Unqual - {OccName: v})))))) - (False))) - ,(L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:18-32 }) - (HsRecField - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:18 } - (UnchangedAnchor)) - [(AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:8:20 }))] - (AnnComments - [])) - (L - { InTreeAnnotations1.hs:8:18 } - (FieldOcc - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:18 }) - (Unqual - {OccName: y})))) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:22-32 }) - (ViewPat - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:22-32 } - (UnchangedAnchor)) - [(AddApiAnn AnnRarrow (AR { InTreeAnnotations1.hs:8:29-30 }))] - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:22-27 }) - (HsVar - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:22-27 }) - (Unqual - {OccName: negate})))) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:32 }) - (VarPat - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:32 }) - (Unqual - {OccName: w})))))) - (False)))] - (Nothing)))))))] - (GRHSs - (NoExtField) - [(L - { InTreeAnnotations1.hs:8:37-43 } - (GRHS - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:37-43 } - (UnchangedAnchor)) - (GrhsAnn - (Nothing) - (AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:8:37 }))) - (AnnComments - [])) - [] - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:39-43 }) - (OpApp - (ApiAnn - (Anchor - { InTreeAnnotations1.hs:8:39-43 } - (UnchangedAnchor)) - [] - (AnnComments - [])) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:39 }) - (HsVar - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:39 }) - (Unqual - {OccName: v})))) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:41 }) - (HsVar - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:41 }) - (Unqual - {OccName: +})))) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:43 }) - (HsVar - (NoExtField) - (L - (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:43 }) - (Unqual - {OccName: w}))))))))] - (EmptyLocalBinds - (NoExtField)))))]) - (FromSource)) - [])))] - (Nothing) - (Nothing))) diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile deleted file mode 100644 index 23151ea43a..0000000000 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ /dev/null @@ -1,32 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - -clean: - rm -f *.o *.hi - rm -f annotations comments - rm -f stringSource - -.PHONY: annotations -annotations: - rm -f annotations.o annotations.hi - '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc annotations - ./annotations "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" - -.PHONY: comments -comments: - rm -f comments.o comments.hi - '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc comments - ./comments "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" - -# .PHONY: T10313 -# T10313: -# rm -f stringSource.o stringSource.hi -# '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc stringSource -# ./stringSource "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10313 - -# .PHONY: T11430 -# T11430: -# rm -f t11430.o t11430.hi t11430 -# '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t11430 -# ./t11430 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test11430 diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T deleted file mode 100644 index b99afdab4a..0000000000 --- a/testsuite/tests/ghc-api/annotations/all.T +++ /dev/null @@ -1,4 +0,0 @@ -test('comments', [normalise_slashes, - extra_files(['CommentsTest.hs']), - ignore_stderr], makefile_test, ['comments']) -test('InTreeAnnotations1',normal, compile, ['-dsuppress-uniques -ddump-parsed-ast']) diff --git a/testsuite/tests/ghc-api/annotations/bundle-export.stdout b/testsuite/tests/ghc-api/annotations/bundle-export.stdout deleted file mode 100644 index e7bff3db75..0000000000 --- a/testsuite/tests/ghc-api/annotations/bundle-export.stdout +++ /dev/null @@ -1,37 +0,0 @@ ----Unattached Annotation Problems (should be empty list)--- -[] ----Ann before enclosing span problem (should be empty list)--- -[ - -] - ----Annotations----------------------- --- SrcSpan the annotation is attached to, AnnKeywordId, --- list of locations the keyword item appears in -[ -((BundleExport.hs:1:1,AnnModule), [BundleExport.hs:2:1-6]), -((BundleExport.hs:1:1,AnnWhere), [BundleExport.hs:2:37-41]), -((BundleExport.hs:2:20-35,AnnCloseP), [BundleExport.hs:2:35]), -((BundleExport.hs:2:20-35,AnnOpenP), [BundleExport.hs:2:20]), -((BundleExport.hs:2:21-28,AnnCloseP), [BundleExport.hs:2:28]), -((BundleExport.hs:2:21-28,AnnComma), [BundleExport.hs:2:25, BundleExport.hs:2:29]), -((BundleExport.hs:2:21-28,AnnDotdot), [BundleExport.hs:2:23-24]), -((BundleExport.hs:2:21-28,AnnOpenP), [BundleExport.hs:2:22]), -((BundleExport.hs:2:31-34,AnnCloseP), [BundleExport.hs:2:34]), -((BundleExport.hs:2:31-34,AnnOpenP), [BundleExport.hs:2:32]), -((BundleExport.hs:4:1-10,AnnData), [BundleExport.hs:4:1-4]), -((BundleExport.hs:4:1-10,AnnEqual), [BundleExport.hs:4:8]), -((BundleExport.hs:4:1-10,AnnSemi), [BundleExport.hs:6:1]), -((BundleExport.hs:6:1-10,AnnData), [BundleExport.hs:6:1-4]), -((BundleExport.hs:6:1-10,AnnEqual), [BundleExport.hs:6:8]), -((BundleExport.hs:6:1-10,AnnSemi), [BundleExport.hs:8:1]), -((BundleExport.hs:8:1-13,AnnEqual), [BundleExport.hs:8:11]), -((BundleExport.hs:8:1-13,AnnPattern), [BundleExport.hs:8:1-7]), -((BundleExport.hs:8:1-13,AnnSemi), [BundleExport.hs:9:1]), -((BundleExport.hs:9:1-13,AnnEqual), [BundleExport.hs:9:11]), -((BundleExport.hs:9:1-13,AnnPattern), [BundleExport.hs:9:1-7]), -((BundleExport.hs:9:1-13,AnnSemi), [BundleExport.hs:10:1]) -] - ----Eof Position (should be Just)----- -Just SrcSpanPoint "BundleExport.hs" 10 1 diff --git a/testsuite/tests/ghc-api/annotations/comments.hs b/testsuite/tests/ghc-api/annotations/comments.hs deleted file mode 100644 index d8c68594d0..0000000000 --- a/testsuite/tests/ghc-api/annotations/comments.hs +++ /dev/null @@ -1,72 +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 Data.List (intercalate) -import System.IO -import GHC -import GHC.Driver.Session -import GHC.Driver.Ppr -import GHC.Utils.Monad -import GHC.Utils.Outputable -import GHC.Data.Bag (filterBag,isEmptyBag) -import System.Directory (removeFile) -import System.Environment( getArgs ) -import qualified Data.Map as Map -import Data.Dynamic ( fromDynamic,Dynamic ) - -main::IO() -main = do - [libdir] <- getArgs - testOneFile libdir "CommentsTest" True - testOneFile libdir "CommentsTest" False - -testOneFile libdir fileName useHaddock = do - p <- runGhc (Just libdir) $ do - dflags <- getSessionDynFlags - let dflags' = if useHaddock - then gopt_set (gopt_set dflags Opt_Haddock) - Opt_KeepRawTokenStream - else gopt_set (gopt_unset dflags Opt_Haddock) - Opt_KeepRawTokenStream - 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_annotations p) - - let anns = p - -- ann_comments = apiAnnComments anns - ann_comments = Map.empty - ann_rcomments = apiAnnRogueComments anns - comments = - map (\(s,v) -> (RealSrcSpan s Nothing, v)) (Map.toList ann_comments) - ++ - [(noSrcSpan, ann_rcomments)] - - putStrLn (intercalate "\n" [showAnns comments]) - -showAnns anns = "[\n" ++ (intercalate "\n" - $ map (\(s,v) - -> ("( " ++ pp s ++" =\n[" ++ showToks v ++ "])\n")) - $ anns) - ++ "]\n" - -showToks ts = intercalate ",\n\n" - $ map (\(L p t) -> "(" ++ pp p ++ "," ++ show t ++ ")") ts - -pp a = showPprUnsafe a diff --git a/testsuite/tests/ghc-api/annotations/comments.stdout b/testsuite/tests/ghc-api/annotations/comments.stdout deleted file mode 100644 index 1b7ed7061a..0000000000 --- a/testsuite/tests/ghc-api/annotations/comments.stdout +++ /dev/null @@ -1,17 +0,0 @@ -[ -( <no location info> = -[(Anchor CommentsTest.hs:11:1-33 UnchangedAnchor,AnnComment {ac_tok = AnnDocCommentNext " The function @foo@ does blah", ac_prior_tok = SrcSpanOneLine "./CommentsTest.hs" 9 31 33}), - -(Anchor CommentsTest.hs:(3,1)-(7,2) UnchangedAnchor,AnnComment {ac_tok = AnnBlockComment "{-\nAn opening comment\n {- with a nested one -}\n {-# nested PRAGMA #-}\n-}", ac_prior_tok = SrcSpanOneLine "./CommentsTest.hs" 2 27 32}), - -(Anchor CommentsTest.hs:1:1-31 UnchangedAnchor,AnnComment {ac_tok = AnnBlockComment "{-# LANGUAGE DeriveFoldable #-}", ac_prior_tok = SrcSpanPoint "./CommentsTest.hs" 1 1})]) -] - -[ -( <no location info> = -[(Anchor CommentsTest.hs:11:1-33 UnchangedAnchor,AnnComment {ac_tok = AnnLineComment "-- | The function @foo@ does blah", ac_prior_tok = SrcSpanOneLine "./CommentsTest.hs" 9 31 33}), - -(Anchor CommentsTest.hs:(3,1)-(7,2) UnchangedAnchor,AnnComment {ac_tok = AnnBlockComment "{-\nAn opening comment\n {- with a nested one -}\n {-# nested PRAGMA #-}\n-}", ac_prior_tok = SrcSpanOneLine "./CommentsTest.hs" 2 27 32}), - -(Anchor CommentsTest.hs:1:1-31 UnchangedAnchor,AnnComment {ac_tok = AnnBlockComment "{-# LANGUAGE DeriveFoldable #-}", ac_prior_tok = SrcSpanPoint "./CommentsTest.hs" 1 1})]) -] diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.stdout b/testsuite/tests/ghc-api/annotations/exampleTest.stdout deleted file mode 100644 index 904b845bfd..0000000000 --- a/testsuite/tests/ghc-api/annotations/exampleTest.stdout +++ /dev/null @@ -1,88 +0,0 @@ ----Unattached Annotation Problems (should be empty list)--- -[] ----Ann before enclosing span problem (should be empty list)--- -[ - -] - ----Annotations----------------------- --- SrcSpan the annotation is attached to, AnnKeywordId, --- list of locations the keyword item appears in -[ -((AnnotationTuple.hs:1:1,AnnCloseC), [AnnotationTuple.hs:27:1]), -((AnnotationTuple.hs:1:1,AnnModule), [AnnotationTuple.hs:3:1-6]), -((AnnotationTuple.hs:1:1,AnnOpenC), [AnnotationTuple.hs:5:1]), -((AnnotationTuple.hs:1:1,AnnWhere), [AnnotationTuple.hs:3:30-34]), -((AnnotationTuple.hs:3:24-28,AnnCloseP), [AnnotationTuple.hs:3:28]), -((AnnotationTuple.hs:3:24-28,AnnOpenP), [AnnotationTuple.hs:3:24]), -((AnnotationTuple.hs:6:1-32,AnnAs), [AnnotationTuple.hs:6:28-29]), -((AnnotationTuple.hs:6:1-32,AnnImport), [AnnotationTuple.hs:6:1-6]), -((AnnotationTuple.hs:6:1-32,AnnQualified), [AnnotationTuple.hs:6:8-16]), -((AnnotationTuple.hs:6:1-32,AnnSemi), [AnnotationTuple.hs:7:1]), -((AnnotationTuple.hs:(8,1)-(11,14),AnnEqual), [AnnotationTuple.hs:8:5]), -((AnnotationTuple.hs:(8,1)-(11,14),AnnFunId), [AnnotationTuple.hs:8:1-3]), -((AnnotationTuple.hs:(8,1)-(11,14),AnnSemi), [AnnotationTuple.hs:13:1]), -((AnnotationTuple.hs:(8,7)-(11,14),AnnIn), [AnnotationTuple.hs:11:7-8]), -((AnnotationTuple.hs:(8,7)-(11,14),AnnLet), [AnnotationTuple.hs:8:7-9]), -((AnnotationTuple.hs:9:9-13,AnnEqual), [AnnotationTuple.hs:9:11]), -((AnnotationTuple.hs:9:9-13,AnnFunId), [AnnotationTuple.hs:9:9]), -((AnnotationTuple.hs:9:9-13,AnnSemi), [AnnotationTuple.hs:10:9]), -((AnnotationTuple.hs:10:9-13,AnnEqual), [AnnotationTuple.hs:10:11]), -((AnnotationTuple.hs:10:9-13,AnnFunId), [AnnotationTuple.hs:10:9]), -((AnnotationTuple.hs:11:10-14,AnnVal), [AnnotationTuple.hs:11:12]), -((AnnotationTuple.hs:14:1-72,AnnEqual), [AnnotationTuple.hs:14:5]), -((AnnotationTuple.hs:14:1-72,AnnFunId), [AnnotationTuple.hs:14:1-3]), -((AnnotationTuple.hs:14:1-72,AnnSemi), [AnnotationTuple.hs:15:1]), -((AnnotationTuple.hs:14:7-72,AnnVal), [AnnotationTuple.hs:14:13]), -((AnnotationTuple.hs:14:19-53,AnnCloseP), [AnnotationTuple.hs:14:53]), -((AnnotationTuple.hs:14:19-53,AnnOpenP), [AnnotationTuple.hs:14:19]), -((AnnotationTuple.hs:14:20,AnnComma), [AnnotationTuple.hs:14:21]), -((AnnotationTuple.hs:14:23-29,AnnComma), [AnnotationTuple.hs:14:33]), -((AnnotationTuple.hs:14:35-37,AnnComma), [AnnotationTuple.hs:14:38]), -((AnnotationTuple.hs:14:39,AnnComma), [AnnotationTuple.hs:14:39]), -((AnnotationTuple.hs:14:41-52,AnnCloseS), [AnnotationTuple.hs:14:52]), -((AnnotationTuple.hs:14:41-52,AnnOpenS), [AnnotationTuple.hs:14:41]), -((AnnotationTuple.hs:14:42,AnnComma), [AnnotationTuple.hs:14:43]), -((AnnotationTuple.hs:14:45,AnnComma), [AnnotationTuple.hs:14:46]), -((AnnotationTuple.hs:14:48,AnnComma), [AnnotationTuple.hs:14:49]), -((AnnotationTuple.hs:14:55-72,AnnCloseS), [AnnotationTuple.hs:14:72]), -((AnnotationTuple.hs:14:55-72,AnnOpenS), [AnnotationTuple.hs:14:55]), -((AnnotationTuple.hs:14:56-62,AnnComma), [AnnotationTuple.hs:14:63]), -((AnnotationTuple.hs:14:61-62,AnnCloseP), [AnnotationTuple.hs:14:62]), -((AnnotationTuple.hs:14:61-62,AnnOpenP), [AnnotationTuple.hs:14:61]), -((AnnotationTuple.hs:16:1-41,AnnEqual), [AnnotationTuple.hs:16:5]), -((AnnotationTuple.hs:16:1-41,AnnFunId), [AnnotationTuple.hs:16:1-3]), -((AnnotationTuple.hs:16:1-41,AnnSemi), [AnnotationTuple.hs:17:1]), -((AnnotationTuple.hs:16:7-27,AnnCloseP), [AnnotationTuple.hs:16:27]), -((AnnotationTuple.hs:16:7-27,AnnOpenP), [AnnotationTuple.hs:16:7]), -((AnnotationTuple.hs:16:8,AnnComma), [AnnotationTuple.hs:16:9]), -((AnnotationTuple.hs:16:11-17,AnnComma), [AnnotationTuple.hs:16:18]), -((AnnotationTuple.hs:16:20-22,AnnComma), [AnnotationTuple.hs:16:23]), -((AnnotationTuple.hs:16:24,AnnComma), [AnnotationTuple.hs:16:24]), -((AnnotationTuple.hs:16:25,AnnComma), [AnnotationTuple.hs:16:25]), -((AnnotationTuple.hs:16:26,AnnComma), [AnnotationTuple.hs:16:26]), -((AnnotationTuple.hs:16:33-41,AnnCloseP), [AnnotationTuple.hs:16:41]), -((AnnotationTuple.hs:16:33-41,AnnOpenP), [AnnotationTuple.hs:16:33]), -((AnnotationTuple.hs:16:39-40,AnnCloseP), [AnnotationTuple.hs:16:40]), -((AnnotationTuple.hs:16:39-40,AnnOpenP), [AnnotationTuple.hs:16:39]), -((AnnotationTuple.hs:18:1-28,AnnData), [AnnotationTuple.hs:18:1-4]), -((AnnotationTuple.hs:18:1-28,AnnDcolon), [AnnotationTuple.hs:18:20-21]), -((AnnotationTuple.hs:18:1-28,AnnFamily), [AnnotationTuple.hs:18:6-11]), -((AnnotationTuple.hs:18:1-28,AnnSemi), [AnnotationTuple.hs:19:1]), -((AnnotationTuple.hs:18:23,AnnRarrow), [AnnotationTuple.hs:18:25-26]), -((AnnotationTuple.hs:18:23-28,AnnRarrow), [AnnotationTuple.hs:18:25-26]), -((AnnotationTuple.hs:(20,1)-(24,14),AnnFunId), [AnnotationTuple.hs:20:1-5]), -((AnnotationTuple.hs:(20,1)-(24,14),AnnSemi), [AnnotationTuple.hs:25:1]), -((AnnotationTuple.hs:(21,7)-(24,14),AnnEqual), [AnnotationTuple.hs:24:7]), -((AnnotationTuple.hs:(21,7)-(24,14),AnnVbar), [AnnotationTuple.hs:21:7]), -((AnnotationTuple.hs:21:9-24,AnnComma), [AnnotationTuple.hs:22:7]), -((AnnotationTuple.hs:21:9-24,AnnLarrow), [AnnotationTuple.hs:21:16-17]), -((AnnotationTuple.hs:22:9-25,AnnComma), [AnnotationTuple.hs:23:7]), -((AnnotationTuple.hs:22:9-25,AnnLarrow), [AnnotationTuple.hs:22:16-17]), -((AnnotationTuple.hs:23:9-24,AnnLarrow), [AnnotationTuple.hs:23:16-17]), -((AnnotationTuple.hs:26:1-10,AnnDcolon), [AnnotationTuple.hs:26:5-6]), -((AnnotationTuple.hs:26:1-14,AnnEqual), [AnnotationTuple.hs:26:12]) -] - ----Eof Position (should be Just)----- -Just SrcSpanPoint "AnnotationTuple.hs" 32 1 diff --git a/testsuite/tests/ghc-api/annotations/stringSource.hs b/testsuite/tests/ghc-api/annotations/stringSource.hs deleted file mode 100644 index b07b00a2ce..0000000000 --- a/testsuite/tests/ghc-api/annotations/stringSource.hs +++ /dev/null @@ -1,146 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} - --- 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 Data.List (intercalate) -import System.IO -import GHC -import GHC.Types.Basic -import GHC.Types.SourceText -import GHC.Unit.Module.Warnings -import GHC.Driver.Session -import GHC.Driver.Ppr -import GHC.Data.FastString -import GHC.Types.ForeignCall -import GHC.Utils.Monad -import GHC.Utils.Outputable -import GHC.Hs.Decls -import GHC.Data.Bag (filterBag,isEmptyBag) -import System.Directory (removeFile) -import System.Environment( getArgs ) -import qualified Data.Map as Map -import Data.Dynamic ( fromDynamic,Dynamic ) - -main::IO() -main = do - [libdir,fileName] <- getArgs - testOneFile libdir fileName - -testOneFile libdir fileName = do - p <- 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 - return p - - let tupArgs = gq (pm_parsed_source p) - - putStrLn (pp tupArgs) - -- putStrLn (intercalate "\n" [showAnns anns]) - - where - gq ast = everything (++) ([] `mkQ` doWarningTxt - `extQ` doImportDecl - `extQ` doCType - `extQ` doRuleDecl - `extQ` doCCallTarget - `extQ` doHsExpr - ) ast - - doWarningTxt :: WarningTxt -> [(String,[Located (SourceText,FastString)])] - doWarningTxt ((WarningTxt _ ss)) = [("w",map conv ss)] - doWarningTxt ((DeprecatedTxt _ ss)) = [("d",map conv ss)] - - doImportDecl :: ImportDecl GhcPs - -> [(String,[Located (SourceText,FastString)])] - doImportDecl (ImportDecl _ _ _ Nothing _ _ _ _ _ _) = [] - doImportDecl (ImportDecl _ _ _ (Just ss) _ _ _ _ _ _) - = [("i",[conv (noLoc ss)])] - - doCType :: CType -> [(String,[Located (SourceText,FastString)])] - doCType (CType src (Just (Header hs hf)) c) - = [("c",[noLoc (hs,hf),noLoc c])] - doCType (CType src Nothing c) = [("c",[noLoc c])] - - doRuleDecl :: RuleDecl GhcPs - -> [(String,[Located (SourceText,FastString)])] - doRuleDecl (HsRule _ ss _ _ _ _ _) = [("r",[ss])] - - doCCallTarget :: CCallTarget - -> [(String,[Located (SourceText,FastString)])] - doCCallTarget (StaticTarget s f _ _) = [("st",[(noLoc (s,f))])] - - doHsExpr :: HsExpr GhcPs -> [(String,[Located (SourceText,FastString)])] - doHsExpr (HsPragE _ prag _) = doPragE prag - doHsExpr _ = [] - - doPragE :: HsPragE GhcPs -> [(String,[Located (SourceText,FastString)])] - doPragE (HsPragSCC _ src ss) = [("sc",[conv (noLoc ss)])] - - conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs) - -showAnns anns = "[\n" ++ (intercalate "\n" - $ map (\((s,k),v) - -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n")) - $ Map.toList anns) - ++ "]\n" - -pp a = showPprUnsafe a - --- --------------------------------------------------------------------- - --- 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 - --- | Extend a generic query by a type-specific case -extQ :: ( Typeable a - , Typeable b - ) - => (a -> q) - -> (b -> q) - -> a - -> q -extQ f g a = maybe (f a) g (cast a) - - --- | 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/annotations/t11430.hs b/testsuite/tests/ghc-api/annotations/t11430.hs deleted file mode 100644 index 0e702769c2..0000000000 --- a/testsuite/tests/ghc-api/annotations/t11430.hs +++ /dev/null @@ -1,133 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} - --- This program must be called with GHC's libdir as the single command line --- argument. -module Main where - --- import Data.Generics -import Data.Data hiding (Fixity) -import Data.List (intercalate) -import System.IO -import GHC -import GHC.Types.Basic -import GHC.Types.SourceText -import GHC.Types.Fixity -import GHC.Driver.Session -import GHC.Driver.Ppr -import GHC.Data.FastString -import GHC.Types.ForeignCall -import GHC.Utils.Monad -import GHC.Utils.Outputable -import GHC.Hs.Decls -import GHC.Data.Bag (filterBag,isEmptyBag) -import System.Directory (removeFile) -import System.Environment( getArgs ) -import qualified Data.Map as Map -import Data.Dynamic ( fromDynamic,Dynamic ) - -main::IO() -main = do - [libdir,fileName] <- getArgs - testOneFile libdir fileName - -testOneFile libdir fileName = do - p <- 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 - return p - - let tupArgs = gq (pm_parsed_source p) - - putStrLn (intercalate "\n" $ map show tupArgs) - -- putStrLn (pp tupArgs) - -- putStrLn (intercalate "\n" [showAnns anns]) - - where - gq ast = everything (++) ([] `mkQ` doFixity - `extQ` doRuleDecl - `extQ` doHsExpr - `extQ` doInline - ) ast - - doFixity :: Fixity -> [(String,[String])] - doFixity (Fixity (SourceText ss) _ _) = [("f",[ss])] - - doRuleDecl :: RuleDecl GhcPs - -> [(String,[String])] - doRuleDecl (HsRule _ _ (ActiveBefore (SourceText ss) _) _ _ _ _) - = [("rb",[ss])] - doRuleDecl (HsRule _ _ (ActiveAfter (SourceText ss) _) _ _ _ _) - = [("ra",[ss])] - doRuleDecl (HsRule _ _ _ _ _ _ _) = [] - - doHsExpr :: HsExpr GhcPs -> [(String,[String])] - doHsExpr _ = [] - - doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _) - = [("ib",[ss])] - doInline (InlinePragma _ _ _ (ActiveAfter (SourceText ss) _) _) - = [("ia",[ss])] - doInline (InlinePragma _ _ _ _ _ ) = [] - -showAnns anns = "[\n" ++ (intercalate "\n" - $ map (\((s,k),v) - -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n")) - $ Map.toList anns) - ++ "]\n" - -pp a = showPprUnsafe a - --- --------------------------------------------------------------------- - --- 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 - --- | Extend a generic query by a type-specific case -extQ :: ( Typeable a - , Typeable b - ) - => (a -> q) - -> (b -> q) - -> a - -> q -extQ f g a = maybe (f a) g (cast a) - - --- | 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) |