Revert "Move check-ppr and check-api-annotations to testsuite/utils"

Unfortunately this (ironically) ended up breaking bindist testing since
we didn't have a package-data.mk. Unfortunately there is no easy way to
fix this.

This reverts commit 1e9f90af7311c33de0f7f5b7dba594725596d675.

4 files changed, 180 insertions, 0 deletions

diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs
new file mode 100644
index 0000000000..a5aeee2f1d
--- /dev/null
+++ b/utils/check-ppr/Main.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import Data.List
+import SrcLoc
+import GHC hiding (moduleName)
+import HsDumpAst
+import DynFlags
+import Outputable hiding (space)
+import System.Environment( getArgs )
+import System.Exit
+import System.FilePath
+
+import qualified Data.Map        as Map
+
+usage :: String
+usage = unlines
+    [ "usage: check-ppr (libdir) (file)"
+    , ""
+    , "where libdir is the GHC library directory (e.g. the output of"
+    , "ghc --print-libdir) and file is the file to parse."
+    ]
+
+main :: IO()
+main = do
+  args <- getArgs
+  case args of
+   [libdir,fileName] -> testOneFile libdir fileName
+   _ -> putStrLn usage
+
+testOneFile :: FilePath -> String -> IO ()
+testOneFile libdir fileName = do
+       p <- parseOneFile libdir fileName
+       let
+         origAst = showSDoc unsafeGlobalDynFlags
+                     $ showAstData BlankSrcSpan (pm_parsed_source p)
+         pped    = pragmas ++ "\n" ++ pp (pm_parsed_source p)
+         anns    = pm_annotations p
+         pragmas = getPragmas anns
+
+         newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName
+         astFile = fileName <.> "ast"
+         newAstFile = fileName <.> "ast.new"
+
+       writeFile astFile origAst
+       writeFile newFile pped
+
+       p' <- parseOneFile libdir newFile
+
+       let newAstStr :: String
+           newAstStr = showSDoc unsafeGlobalDynFlags
+                         $ showAstData BlankSrcSpan (pm_parsed_source p')
+       writeFile newAstFile newAstStr
+
+       if origAst == newAstStr
+         then do
+           -- putStrLn "ASTs matched"
+           exitSuccess
+         else do
+           putStrLn "AST Match Failed"
+           putStrLn "\n===================================\nOrig\n\n"
+           putStrLn origAst
+           putStrLn "\n===================================\nNew\n\n"
+           putStrLn newAstStr
+           exitFailure
+
+
+parseOneFile :: FilePath -> FilePath -> IO ParsedModule
+parseOneFile libdir fileName = do
+       let modByFile m =
+             case ml_hs_file $ ms_location m of
+               Nothing -> False
+               Just fn -> fn == fileName
+       runGhc (Just libdir) $ do
+         dflags <- getSessionDynFlags
+         let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream
+         _ <- setSessionDynFlags dflags2
+         addTarget Target { targetId = TargetFile fileName Nothing
+                          , targetAllowObjCode = True
+                          , targetContents = Nothing }
+         _ <- load LoadAllTargets
+         graph <- getModuleGraph
+         let
+           modSum = case filter modByFile (mgModSummaries graph) of
+                     [x] -> x
+                     xs -> error $ "Can't find module, got:"
+                              ++ show (map (ml_hs_file . ms_location) xs)
+         parseModule modSum
+
+getPragmas :: ApiAnns -> String
+getPragmas anns = pragmaStr
+  where
+    tokComment (L _ (AnnBlockComment s)) = s
+    tokComment (L _ (AnnLineComment  s)) = s
+    tokComment _ = ""
+
+    comments = case Map.lookup noSrcSpan (snd anns) of
+      Nothing -> []
+      Just cl -> map tokComment $ sortLocated cl
+    pragmas = filter (\c -> isPrefixOf "{-#" c ) comments
+    pragmaStr = intercalate "\n" pragmas
+
+pp :: (Outputable a) => a -> String
+pp a = showPpr unsafeGlobalDynFlags a
+
+
diff --git a/utils/check-ppr/README b/utils/check-ppr/README
new file mode 100644
index 0000000000..f9b502e4a7
--- /dev/null
+++ b/utils/check-ppr/README
@@ -0,0 +1,26 @@
+
+This programme is intended to be used by any GHC developers working on the AST
+and/or pretty printer by providing a way to check that the same AST is generated
+from the pretty printed AST as from the original source.
+
+i.e., it checks whether
+
+    parse (ppr (parse s)) === parse s
+
+
+This utility is also intended to be used in tests, so that when new features are
+added the ability to round-trip the AST via ppr is tested.
+
+Usage
+
+In a test Makefile
+
+  $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" FileToParse.hs
+
+See examples in (REPO_HOME)/testsuite/tests/printer/Makefile
+
+The utility generates the following files for ToBeTested.hs
+
+  - ToBeTested.ppr.hs      : the ppr result
+  - ToBeTested.hs.ast      : the AST of the original source
+  - ToBeTested.hs.ast.new  : the AST of the re-parsed ppr source
diff --git a/utils/check-ppr/check-ppr.cabal b/utils/check-ppr/check-ppr.cabal
new file mode 100644
index 0000000000..584558b3ff
--- /dev/null
+++ b/utils/check-ppr/check-ppr.cabal
@@ -0,0 +1,31 @@
+Name: check-ppr
+Version: 0.1
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: A utilities for checking the consistency of GHC's pretty printer
+Description:
+    This utility is used to check the consistency of the GHC pretty printer, by
+    parsing a file, pretty printing it, and then re-parsing the pretty printed
+    version. See @utils/check-ppr/README@ in GHC's source distribution for
+    details.
+Category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+Executable check-ppr
+    Default-Language: Haskell2010
+
+    Main-Is: Main.hs
+
+    Ghc-Options: -Wall
+
+    Build-Depends: base       >= 4   && < 5,
+                   bytestring,
+                   containers,
+                   Cabal      >= 2.0 && < 2.1,
+                   directory,
+                   filepath,
+                   ghc
diff --git a/utils/check-ppr/ghc.mk b/utils/check-ppr/ghc.mk
new file mode 100644
index 0000000000..189b447171
--- /dev/null
+++ b/utils/check-ppr/ghc.mk
@@ -0,0 +1,18 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+#      http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+#      http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+utils/check-ppr_USES_CABAL                   = YES
+utils/check-ppr_PACKAGE                      = check-ppr
+utils/check-ppr_dist-install_PROGNAME        = check-ppr
+utils/check-ppr_dist-install_INSTALL         = NO
+utils/check-ppr_dist-install_INSTALL_INPLACE = YES
+$(eval $(call build-prog,utils/check-ppr,dist-install,2))