From 82a7cebaea5dce16fc9658cc6a5ec037348075d1 Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Sun, 27 Apr 2008 11:48:08 +0000
Subject: [PATCH] Fix an error if an SCC name contains a space; fixes trac
 #2071

---
 compiler/parser/Parser.y.pp |   12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index bfcc856..6a34c2d 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -1309,8 +1309,8 @@ exp10 :: { LHsExpr RdrName }
 
 scc_annot :: { Located FastString }
 	: '_scc_' STRING			{% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
-                                   (return $ LL $ getSTRING $2) }
-	| '{-# SCC' STRING '#-}'		{ LL $ getSTRING $2 }
+                                   ( do scc <- getSCC $2; return $ LL scc ) }
+	| '{-# SCC' STRING '#-}'		{% do scc <- getSCC $2; return $ LL scc }
 
 hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
 	: '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
@@ -1969,6 +1969,14 @@ getDOCPREV (L _ (ITdocCommentPrev x)) = x
 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
 
+getSCC :: Located Token -> P FastString
+getSCC lt = do let s = getSTRING lt
+                   err = "Spaces are not allowed in SCCs"
+               -- We probably actually want to be more restrictive than this
+               if ' ' `elem` unpackFS s
+                   then failSpanMsgP (getLoc lt) (text err)
+                   else return s
+
 -- Utilities for combining source spans
 comb2 :: Located a -> Located b -> SrcSpan
 comb2 a b = a `seq` b `seq` combineLocs a b
-- 
1.7.10.4