...
 
......@@ -1136,7 +1136,15 @@ hsSigDoc (SpecSig _ _ _ inl)
= ppr inl <+> text "pragma"
hsSigDoc (InlineSig _ _ prag) = ppr (inlinePragmaSpec prag) <+> text "pragma"
hsSigDoc (SpecInstSig _ src _)
= pprWithSourceText src empty <+> text "instance pragma"
-- As per the 'Note ([Pragma source text])' in
-- compiler/GHC/Types/Basics.hs, the SourceText in
-- SpecInstSig includes "{-#" before the pragma
-- itself, hence the source text here is stripped of
-- all characters before the pragma name string
= pprWithSourceText srcTxt empty <+> text "instance pragma"
where srcTxt = case src of
SourceText s -> SourceText (extractSigDocText s "{-# ")
NoSourceText -> NoSourceText
hsSigDoc (FixSig {}) = text "fixity declaration"
hsSigDoc (MinimalSig {}) = text "MINIMAL pragma"
hsSigDoc (SCCFunSig {}) = text "SCC pragma"
......
......@@ -102,7 +102,7 @@ module GHC.Types.Basic (
mkIntegralLit, mkFractionalLit,
integralFractionalLit,
SourceText(..), pprWithSourceText,
SourceText(..), pprWithSourceText, extractSigDocText,
IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit,
......@@ -1292,6 +1292,16 @@ pprWithSourceText :: SourceText -> SDoc -> SDoc
pprWithSourceText NoSourceText d = d
pprWithSourceText (SourceText src) _ = text src
-- Helper function to remove a set of specified characters
-- from a string. This is used in compiler/GHC/Hs/Binds.hs to
-- clean up pragma strings (the SpecInstSig type)
extractSigDocText :: [Char] -> [Char] -> [Char]
extractSigDocText str elems = f str
where f (x:xs) | words (x:xs) == [] = " "
| x `elem` elems = f xs
| xs == [] = [x]
| otherwise = [x] ++ f xs
{-
************************************************************************
* *
......
Misplaced.hs:4:1: error:
Misplaced {-# SPECIALISE instance pragma:
Misplaced SPECIALISE instance pragma:
{-# SPECIALISE instance Eq (T Int) #-}
module MisplacedNoSpace where
instance Eq (T a)
{-#SPECIALISE instance Eq (T Int) #-}
-- A mis-placed signature without spaces before the
-- pragma string
data T a = T
MisplacedNoSpace.hs:4:1: error:
Misplaced SPECIALISE instance pragma:
{-#SPECIALISE instance Eq (T Int) #-}
......@@ -80,6 +80,7 @@ test('T5513', normal, compile_fail, [''])
test('T5533', normal, compile_fail, [''])
test('T5589', normal, compile_fail, [''])
test('Misplaced', normal, compile_fail, [''])
test('MisplacedNoSpace', normal, compile_fail, [''])
test('T5657', normal, compile_fail, [''])
test('T5745', [], multimod_compile_fail, ['T5745', '-v0'])
test('T5892a', normal, compile_fail, ['-package containers'])
......