mirror of
https://github.com/google/ghc-source-gen.git
synced 2024-09-11 22:07:09 +03:00
Make tyPromotedVar
pretty-print as 'Abc
not Abc
. (#44)
Also make it possible for unit tests to change behavior based on the version of GHC.
This commit is contained in:
parent
bed038cd28
commit
18f8e8d2c2
@ -28,7 +28,7 @@ import GHC.SourceGen.Type.Internal
|
|||||||
|
|
||||||
-- | A promoted name, for example from the @DataKinds@ extension.
|
-- | A promoted name, for example from the @DataKinds@ extension.
|
||||||
tyPromotedVar :: RdrNameStr -> HsType'
|
tyPromotedVar :: RdrNameStr -> HsType'
|
||||||
tyPromotedVar = noExt HsTyVar notPromoted . typeRdrName
|
tyPromotedVar = noExt HsTyVar promoted . typeRdrName
|
||||||
|
|
||||||
stringTy :: String -> HsType'
|
stringTy :: String -> HsType'
|
||||||
stringTy = noExt HsTyLit . noSourceText HsStrTy . fromString
|
stringTy = noExt HsTyLit . noSourceText HsStrTy . fromString
|
||||||
|
16
tests/GhcVersion.hs
Normal file
16
tests/GhcVersion.hs
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
-- A module for changing behavior based on the version of GHC.
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
module GhcVersion where
|
||||||
|
|
||||||
|
import Data.Version
|
||||||
|
import Text.ParserCombinators.ReadP
|
||||||
|
|
||||||
|
ghcVersion :: Version
|
||||||
|
ghcVersion = case readP_to_S (parseVersion <* eof) VERSION_ghc of
|
||||||
|
[(v,"")] -> v
|
||||||
|
_ -> error $ "Unable to parse GHC version " ++ show VERSION_ghc
|
||||||
|
|
||||||
|
ifGhc88 :: a -> a -> a
|
||||||
|
ifGhc88 x y = if makeVersion [8,8] <= ghcVersion
|
||||||
|
then x
|
||||||
|
else y
|
@ -11,6 +11,7 @@ import Test.Tasty
|
|||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit
|
||||||
|
|
||||||
import GHC.SourceGen
|
import GHC.SourceGen
|
||||||
|
import GhcVersion
|
||||||
|
|
||||||
data TestCase a = String :~ a
|
data TestCase a = String :~ a
|
||||||
|
|
||||||
@ -98,6 +99,11 @@ typesTest dflags = testGroup "Type"
|
|||||||
, "[x]" :~ listPromotedTy [var "x"]
|
, "[x]" :~ listPromotedTy [var "x"]
|
||||||
, "[y, z]" :~ listPromotedTy [var "y", var "z"]
|
, "[y, z]" :~ listPromotedTy [var "y", var "z"]
|
||||||
]
|
]
|
||||||
|
, test "tyPromotedVar"
|
||||||
|
-- For some reason, older GHC pretty-printed an extra space.
|
||||||
|
[ ifGhc88 "'Abc" " 'Abc" :~ tyPromotedVar "Abc"
|
||||||
|
, ifGhc88 "T 'Abc" "T 'Abc" :~ var "T" @@ tyPromotedVar "Abc"
|
||||||
|
]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
test = testTypes dflags
|
test = testTypes dflags
|
||||||
|
Loading…
Reference in New Issue
Block a user