From 4c263dba7eed113cc1ca0d2fd5a7377a81cfabe7 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Fri, 12 Sep 2008 14:39:57 +0000
Subject: [PATCH] Added support for poison to the lexer and parser (and
 associated tests)

---
 frontends/LexRain.x        |  2 +-
 frontends/ParseRain.hs     |  4 +++-
 frontends/ParseRainTest.hs | 14 +++++++++++++-
 3 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/frontends/LexRain.x b/frontends/LexRain.x
index 2ddae62..8048b95 100644
--- a/frontends/LexRain.x
+++ b/frontends/LexRain.x
@@ -42,7 +42,7 @@ $hexDigit = [0-9 a-f A-F]
           | "return" | "now"
           | "wait" | "for" | "until"
           | "if" | "while" | "else"
-          | "pri" | "alt"
+          | "pri" | "alt" | "poison"
           | "sint8" | "sint16" | "sint32" | "sint64"
           | "uint8" | "uint16" | "uint32" | "uint64"
           | "int" | "bool" | "time" | "channel"
diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs
index 911570e..91024b5 100644
--- a/frontends/ParseRain.hs
+++ b/frontends/ParseRain.hs
@@ -56,7 +56,7 @@ instance Die (GenParser tok st) where
 sLeftQ, sRightQ, sLeftR, sRightR, sLeftC, sRightC, sSemiColon, sColon,
   sComma, sIn, sOut, sDots, sPar, sSeq, sAlt, sPri, sSeqeach, sPareach,
   sChannel, sOne2One, sIf, sElse, sWhile, sProcess, sFunction, sReturn,
-  sWait, sFor, sUntil :: RainParser Meta
+  sWait, sFor, sUntil, sPoison :: RainParser Meta
 
 --{{{ Symbols
 sLeftQ = reserved "["
@@ -92,6 +92,7 @@ sReturn = reserved "return"
 sWait = reserved "wait"
 sFor = reserved "for"
 sUntil = reserved "until"
+sPoison = reserved "poison"
 --}}}
 
 --{{{Operators
@@ -462,6 +463,7 @@ statement
       rainTimerName) wm}
     <|> try (comm False)
     <|> alt
+    <|> do {m <- sPoison ; ch <- lvalue; sSemiColon ; return $ A.InjectPoison m ch}
     <|> try (do { lv <- lvalue ; op <- assignOp ; exp <- expression ; sSemiColon ; 
              case op of 
                (m', Just dyOp) -> return (A.Assign m' [lv] (A.ExpressionList m' [(A.Dyadic m' dyOp (A.ExprVariable (findMeta lv) lv) exp)]))
diff --git a/frontends/ParseRainTest.hs b/frontends/ParseRainTest.hs
index 5d4bf97..f685192 100644
--- a/frontends/ParseRainTest.hs
+++ b/frontends/ParseRainTest.hs
@@ -731,7 +731,18 @@ testTime =
  ]
  where
    timer = mVariable RP.rainTimerName
-        
+
+testPoison :: [ParseTest A.Process]
+testPoison =
+ [
+  pass ("poison x;", RP.statement, assertPatternMatch "testPoison 0" $
+    mInjectPoison $ variablePattern "x")
+  ,fail ("poison 0;", RP.statement)
+  ,fail ("poison 0", RP.statement)
+  ,fail ("poison;", RP.statement)
+  ,fail ("poison", RP.statement)
+ ]
+
 --Returns the list of tests:
 tests :: Test
 tests = TestLabel "ParseRainTest" $ TestList
@@ -752,6 +763,7 @@ tests = TestLabel "ParseRainTest" $ TestList
   parseTests testTime,
   parseTests testRun,
   parseTests testDecl,
+  parseTests testPoison,
   parseTests testTopLevelDecl
  ]
 --TODO test: