Ticket #7918: T7918.hs

File T7918.hs, 2.2 KB (added by edsko, 22 months ago)

Test case (fix silly misuse of SYB; fix unrelated to bug)

Line 
1{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, NamedFieldPuns #-}
2{-# OPTIONS_GHC -Wall #-}
3{-
4  | Demonstrates an inconsistency in the locations assigned to expanded TH
5  splices.
6
7  Since it uses the GHC API which now uses dynamic loading, remember to
8  DYLD_LIBRARY_PATH (when appropriate; see the "ghc" script for an example).
9  If you don't, you might see errors such as
10
11  > T7918: <command line>: can't load .so/.DLL for: /path/to/ghc/libraries/integer-gmp/dist-install/build/libHSinteger-gmp-0.5.1.0-ghc7.7.20130826.dylib (dlopen(/path/to/ghc/libraries/integer-gmp/dist-install/build/libHSinteger-gmp-0.5.1.0-ghc7.7.20130826.dylib, 9): Library not loaded: @loader_path/../ghc-prim-0.3.1.0/libHSghc-prim-0.3.1.0-ghc7.7.20130826.dylib
12  > Referenced from: /path/to/ghc/libraries/integer-gmp/dist-install/build/libHSinteger-gmp-0.5.1.0-ghc7.7.20130826.dylib
13  > Reason: image not found)
14
15  Compile using
16
17  > /path/to/ghc T7918.hs -main-is T7918
18-}
19module T7918 (main) where
20
21import System.Process (readProcess)
22import Control.Monad
23import Data.Generics
24
25import GHC
26import DynFlags 
27import MonadUtils (liftIO)
28import Outputable (showSDoc, ppr)
29
30traverseExpr :: LHsExpr Id -> Ghc (LHsExpr Id)
31traverseExpr expr@(L loc (HsVar var)) = do
32  dynFlags <- getSessionDynFlags
33  liftIO . putStrLn $ "Found HsVar " ++ showSDoc dynFlags (ppr var)
34                   ++ "\tat " ++ showSDoc dynFlags (ppr loc)
35  return expr
36traverseExpr expr =
37  return expr
38
39traverse' :: Data a => a -> Ghc a
40traverse' = everywhereM (mkM traverseExpr)
41
42test7918 :: Ghc ()
43test7918 = do
44  dynFlags <- getSessionDynFlags
45  void $ setSessionDynFlags (gopt_set dynFlags Opt_BuildDynamicToo)
46
47  let target = Target {
48                   targetId           = TargetFile "T7918B.hs" Nothing
49                 , targetAllowObjCode = True
50                 , targetContents     = Nothing
51                 }
52  setTargets [target]
53  void $ load LoadAllTargets
54
55  typecheckedB <- getModSummary (mkModuleName "T7918B") >>= parseModule >>= typecheckModule
56  void $ traverse' (tm_typechecked_source typecheckedB)
57
58main :: IO ()
59main = do
60  [libdir] <- lines `liftM` readProcess "ghc" ["--print-libdir"] ""
61  putStrLn $ "Using " ++ show libdir ++ " for libdir"
62  runGhc (Just libdir) test7918