Permalink
Browse files

Add a preprocessor to the parser

To call scripts in other files and replace the parameters
  • Loading branch information...
1 parent a617f8c commit af1e809a4bd973c0a55bf5114d583dfe56f9b14a SebastianBerchtold committed Jan 18, 2012
Showing with 346 additions and 67 deletions.
  1. +4 −36 Diagnoser/DiagScriptParser.hs
  2. +31 −0 Diagnoser/ParserUtils.hs
  3. +183 −0 Diagnoser/PreProcessor.hs
  4. +0 −1 Diagnoser/ScriptDatatypes.hs
  5. +0 −2 Diagnoser/TestCaseExecuter.hs
  6. +5 −18 Tests/DiagnoserScriptParserTests.hs
  7. +0 −1 Tests/ExecuterTests.hs
  8. +83 −0 Tests/PreProcessorTests.hs
  9. +5 −0 Tests/diagnoser/implemented/Callscript/between.skr
  10. +1 −0 Tests/diagnoser/implemented/Callscript/canMsg.skr
  11. +1 −0 Tests/diagnoser/implemented/Callscript/canMsg_target.skr
  12. +1 −0 Tests/diagnoser/implemented/Callscript/cyclicCanMsg.skr
  13. +3 −0 Tests/diagnoser/implemented/Callscript/cyclicCanMsg_target.skr
  14. +1 −0 Tests/diagnoser/implemented/Callscript/nested.skr
  15. +1 −0 Tests/diagnoser/implemented/Callscript/nestedWithParameters.skr
  16. +1 −0 Tests/diagnoser/implemented/Callscript/nestedWithParameters_target.skr
  17. +1 −0 Tests/diagnoser/implemented/Callscript/nestedWithParameters_target2.skr
  18. +1 −0 Tests/diagnoser/implemented/Callscript/nested_target.skr
  19. +2 −0 Tests/diagnoser/implemented/Callscript/simple.skr
  20. +2 −0 Tests/diagnoser/implemented/Callscript/simpleTwoNewlines_target.skr
  21. +1 −0 Tests/diagnoser/implemented/Callscript/simple_target.skr
  22. +2 −0 Tests/diagnoser/implemented/Callscript/subFolder.skr
  23. +2 −0 Tests/diagnoser/implemented/Callscript/subfolder/parentFolder.skr
  24. +1 −0 Tests/diagnoser/implemented/Callscript/subfolder/subFolder_target.skr
  25. +3 −0 Tests/diagnoser/implemented/Callscript/withParameters.skr
  26. +3 −0 Tests/diagnoser/implemented/Callscript/withParametersBetween_target.skr
  27. +2 −0 Tests/diagnoser/implemented/Callscript/withParametersSimple_target.skr
  28. +2 −0 Tests/diagnoser/implemented/Callscript/withParameters_target.skr
  29. +0 −4 Tests/diagnoser/implemented/callscriptSimple.skr
  30. +0 −3 Tests/diagnoser/implemented/callscriptWithParameter.skr
  31. +0 −1 Tests/diagnoser/implemented/callscriptWithParameters.skr
  32. +4 −1 Tests/testMain.hs
@@ -3,31 +3,15 @@ module Diagnoser.DiagScriptParser
where
import Data.Word(Word8,Word16)
-import qualified Text.ParserCombinators.Parsec.Token as P
+
import Util.Encoding
import Text.ParserCombinators.Parsec.Language
import Control.Applicative
import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))
import Data.Char(toUpper)
import Diagnoser.ScriptDatatypes
-
--- TODO: add remaning reserved names
-lexer :: P.TokenParser ()
-lexer = P.makeTokenParser $ haskellStyle
- { P.reservedNames = ["LOOPSTART", "LOOPEND","GROUPSTART","GROUPEND","DIAG","SEND","EXPECT","TIMEOUT","SOURCE","TARGET"]
- , P.commentLine = "//"
- }
-
-whiteSpace = P.whiteSpace lexer
-symbol = P.symbol lexer
-natural = P.natural lexer
-parens = P.parens lexer
-semi = P.semi lexer
-identifier = P.identifier lexer
-reserved = P.reserved lexer
-brackets = P.brackets lexer
-reservedOp = P.reservedOp lexer
+import Diagnoser.ParserUtils
diagscript :: Parser DiagScript
@@ -41,8 +25,6 @@ scriptelem = ScriptTestCase <$> testcase
<|> group
<|> cyclicCanMsg
<|> Useraction <$> (reserved "USERACTION" *> parens parseString)
- <|> Callscript <$> (reserved "CALLSCRIPT" *> filePath)
- <*> (whiteSpace *> option [] parameterList)
<|> CanMsg <$> (reserved "CANMSG" *> nameInBrackets)
<*> (reserved "ID" *> brackets hexNum16)
<*> (reserved "DATA" *> hexList)
@@ -89,23 +71,11 @@ testcase = do name <- reserved "DIAG" *> nameInBrackets
-
+------------------------------------------------------- remove
-- TODO: make filePath match windows/unix file paths
filePath :: CharParser () FilePath
filePath = many1 $ noneOf "\"\r\n "
-
--- TODO: maybe making parser accept whitespaces around equals sign
-parameter :: GenParser Char () Parameter
-parameter = do char '"'
- name <- many1 $ oneOf varNameChars
- char '"'; char '='; char '"'
- var <- hexListNoBrackets
- char '"'
- return $ Parameter name var
-
-
-parameterList :: CharParser () [Parameter]
-parameterList = brackets $ sepBy parameter (symbol ";")
+----------------------------------------------------
hexListNoBrackets :: CharParser () [Word8]
hexListNoBrackets = sepBy hexNum (symbol ",")
@@ -148,8 +118,6 @@ hexList = brackets (sepBy hexNum (symbol ","))
parseString :: GenParser Char st String
parseString = char '"' *> many (noneOf "\"") <* char '"'
-nameInBrackets = brackets (many1 $ noneOf "\"\r\n[]")
-varNameChars = ['a'..'z']++['A'..'Z']++"_- "++['0'..'9']
View
@@ -0,0 +1,31 @@
+module Diagnoser.ParserUtils where
+import qualified Text.ParserCombinators.Parsec.Token as P
+import Text.ParserCombinators.Parsec.Language
+import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))
+import Control.Applicative
+
+-- TODO: add remaning reserved names
+lexer :: P.TokenParser ()
+lexer = P.makeTokenParser $ haskellStyle
+ { P.reservedNames = ["LOOPSTART", "LOOPEND","GROUPSTART","GROUPEND","DIAG","SEND","EXPECT","TIMEOUT","SOURCE","TARGET"]
+ , P.commentLine = "//"
+ }
+
+whiteSpace = P.whiteSpace lexer
+symbol = P.symbol lexer
+natural = P.natural lexer
+parens = P.parens lexer
+semi = P.semi lexer
+identifier = P.identifier lexer
+reserved = P.reserved lexer
+brackets = P.brackets lexer
+reservedOp = P.reservedOp lexer
+
+
+
+eol = try (string "\r\n")
+ <|> string "\n"
+ <|> string "\r"
+ <?> "End of Line"
+
+nameInBrackets = brackets (many1 $ noneOf "\"\r\n[]")
View
@@ -0,0 +1,183 @@
+module Diagnoser.PreProcessor where
+
+import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))
+import Control.Applicative
+
+import System.Directory
+import qualified System.FilePath as FP-- (isAbsolute,combine)
+
+import qualified Data.Map as Map
+import Data.List
+import Data.Either
+
+import Diagnoser.ParserUtils
+import Debug.Trace
+
+-- TODO ADD further Script elements for replacment: CyclicCanMsg etc.
@marcmo

marcmo Jan 19, 2012

obsolete...isn't it?

+
+data RelevantOrNot = Irrelevant String -- any other constructor is relevant for replacing parameters
+ | CallScript FilePath
+ [(String,String)] -- name value pairs
+ | Diag String -- name
+ [String] -- send
+ [String] -- expect
+ String -- timeout
+ (Maybe String) -- source
+ (Maybe String) -- target
+ | CanMsg String String [String]
+ | CyclicCanMsg String String [String] String
+ deriving (Show)
+
+
+relevants :: Parser [RelevantOrNot]
+relevants = do (many relevantOrNot) <* eof
+
+relevantOrNot :: Parser RelevantOrNot
+relevantOrNot = try (relevant <* eol)
+ <|> try relevant -- for the last line
+ <|> Irrelevant <$> try (manyTill anyChar eol)
+ <|> Irrelevant <$> many1 anyChar -- for the last line
+ <?> "Relevant Or Irrelevant Line"
+
+relevant :: Parser RelevantOrNot
+relevant = try callScript
+ <|> try canMsg
+ <|> try cyclicCanMsg
+ <|> diag
+
+diag :: Parser RelevantOrNot
+diag = do name <- reserved "DIAG" *> nameInBrackets
+ send <- reserved "SEND" *> paraNameList
+ expect <- reserved "EXPECT" *> paraNameList
+ timeout <- reserved "TIMEOUT" *> brackets paraName
+ snt <- sourceAndTarget
+ return $ Diag name send expect timeout (fst snt) (snd snt)
+ where sourceAndTarget :: CharParser () (Maybe String, Maybe String)
+ sourceAndTarget = do source <- reserved "SOURCE" *> brackets paraName
+ target <- reserved "TARGET" *> brackets paraName
+ return (Just source, Just target)
+ <|> return (Nothing, Nothing)
+
+
+canMsg :: Parser RelevantOrNot
+canMsg = CanMsg <$> (reserved "CANMSG" *> nameInBrackets)
+ <*> (reserved "ID" *> brackets paraName)
+ <*> (reserved "DATA" *> paraNameList)
+
+cyclicCanMsg :: Parser RelevantOrNot
+cyclicCanMsg = do name <- reserved "STARTCYCLICCANMSG" *> nameInBrackets
+ id <- reserved "ID" *> brackets paraName
+ dat <- reserved "DATA" *> paraNameList
+ cycle <- reserved "CYCLE" *> brackets paraName
+-- ss <- many scriptelem <*
+-- reserved "STOPCYCLICCANMSG" <* brackets (string name) -------- just an irrelevant line
+ return $ CyclicCanMsg name id dat cycle
+
+paraNameList :: CharParser () [String]
+paraNameList = brackets $ sepBy paraName (symbol ",")
+
+paraName :: CharParser () String
+paraName = many1 $ oneOf varNameChars
+
+varNameChars = ['a'..'z']++['A'..'Z']++"_- "++['0'..'9']++"*?"
+
+callScript :: Parser RelevantOrNot
+callScript = CallScript <$> (reserved "CALLSCRIPT" *> filePath)
+ <*> (whiteSpace *> option [] nameValuePairList)
+
+
+-- TODO: make filePath match windows/unix file paths
@marcmo

marcmo Jan 19, 2012

you can use pathSeparator from module System.FilePath

+filePath :: CharParser () FilePath
+filePath = many1 $ noneOf "\"\r\n "
+
+nameValuePair :: Parser (String,String)
+nameValuePair = do
+ char '"'
+ name <- many1 $ oneOf varNameChars
+ char '"'; char '='; char '"'
+ var <- many1 $ oneOf (varNameChars ++ ",")
+ char '"'
+ return $ (name,var)
+
+nameValuePairList :: Parser [(String,String)]
+nameValuePairList = brackets $ sepBy nameValuePair (symbol ";")
+
+-- end of parser -------------------------------------------------------------------------
+
+replaceParameters :: [(String,String)] -> RelevantOrNot -> RelevantOrNot
+replaceParameters nameValPairs (Irrelevant s) = Irrelevant s
+replaceParameters nameValPairs (Diag name send expect timeout source target) =
+ Diag name
+ (replaceParameterList nameValPairs send)
+ (replaceParameterList nameValPairs expect)
+ (replaceParameter nameValPairs timeout)
+ (fmap (replaceParameter nameValPairs) source)
+ (fmap (replaceParameter nameValPairs) target)
+replaceParameters nameValPairs (CanMsg name id dat) =
+ CanMsg name (replaceParameter nameValPairs id) (replaceParameterList nameValPairs dat)
+replaceParameters nameValPairs (CyclicCanMsg name id dat cycle) =
+ CyclicCanMsg name (replaceParameter nameValPairs id) (replaceParameterList nameValPairs dat) (replaceParameter nameValPairs cycle)
+replaceParameters nameValPairs (CallScript name nameValPairsChild) = CallScript name $ replaceCallScriptParameterList nameValPairs nameValPairsChild
+
+
+
+replaceCallScriptParameter :: [(String,String)] -> (String,String) -> (String,String)
+replaceCallScriptParameter nvs (n,v) = (n, Map.findWithDefault v v (Map.fromList nvs))
+
+replaceCallScriptParameterList :: [(String,String)] -> [(String,String)] -> [(String,String)]
+replaceCallScriptParameterList nvs ns = map (replaceCallScriptParameter nvs) ns
+
+replaceParameter :: [(String,String)] -> String -> String
+replaceParameter ps n = Map.findWithDefault n n (Map.fromList ps)
+
+replaceParameterList :: [(String,String)] -> [String] -> [String]
+replaceParameterList ps ns = map (replaceParameter ps) ns
+
+
+
+showRelevant :: FilePath -> RelevantOrNot -> IO (Either ParseError String)
+showRelevant _ (Irrelevant s) = trace "show irrel: " $ return $ Right s
+showRelevant _ (Diag name send expect timeout source target) = return $ Right $
+ "DIAG " ++ (bracketed name) ++
+ " SEND " ++ (bracketed $ concat $ intersperse "," send) ++
+ " EXPECT " ++ (bracketed $ concat $ intersperse "," expect) ++
+ " TIMEOUT " ++ (bracketed timeout) ++ sourceAndTarget source target
+ where sourceAndTarget Nothing Nothing = ""
+ sourceAndTarget (Just source) (Just target) = " SOURCE " ++ bracketed source ++
+ " TARGET " ++ bracketed target
+showRelevant _ (CanMsg name id dat) = return $ Right $
+ "CANMSG " ++ (bracketed name) ++
+ " ID " ++ (bracketed id) ++
+ " DATA " ++ (bracketedList dat)
+showRelevant _ (CyclicCanMsg name id dat cycle) = return $ Right $
+ "STARTCYCLICCANMSG " ++ (bracketed name) ++
+ " ID " ++ (bracketed id) ++
+ " DATA " ++ (bracketedList dat) ++
+ " CYCLE " ++ (bracketed cycle)
+showRelevant parentFilePath (CallScript filePath nameValPairs) = do script <- readFile newFilePath
+ prePro newFilePath nameValPairs
+ where newFilePath = let dir = FP.dropFileName parentFilePath in
+ FP.combine dir filePath
+
+bracketed s = "[" ++ s ++ "]"
+bracketedList s = bracketed $ concat $ intersperse "," s
+
+prePro :: FilePath -> [(String,String)] -> IO (Either ParseError String)
+prePro filePath nameValPairs =
+ do script <- readFile (trace ("prePro" ++ show filePath ++ show nameValPairs) filePath)
+ let rels = parse relevants "Seperate Irreveant from Relevant lines" script
+ case rels of
+ (Left a) -> return $ Left a
+ (Right a) -> (combineRelevants $ map (replaceParameters nameValPairs) a)
+ where combineRelevants :: [RelevantOrNot] -> IO (Either ParseError String)
+ combineRelevants items = do is <- sequence $ map (showRelevant filePath) items
+ if null (lefts is)
+ then (return $ Right $ concat $ intersperse "\n" (rights is))
+ else (return $ Left $ head (lefts is))
+
+
+
+preProcess :: FilePath -> IO (Either ParseError String)
+preProcess filePath =
+ prePro filePath []
+
@@ -10,7 +10,6 @@ data ScriptElement = ScriptTestCase TestCase
| Group String [ScriptElement]
| Wait Int
| Useraction String
- | Callscript FilePath [Parameter]
| CanMsg String Word16 [Word8]
| CyclicCanMsg String Word16 [Word8] Int [ScriptElement]
deriving (Show,Eq)
@@ -61,7 +61,6 @@ runScriptElement n s@(CyclicCanMsg _ _ _ _ ss) = do writeScriptElementStart n s
runScriptWithIndent (n + 2) ss
writeScriptElementEnd n s
runScriptElement n s@(CanMsg name id dat) = writeScriptElement n s >> putStrLn "!! CanMsg not Implemented!!!!!!!"
-runScriptElement n s@(Callscript file params) = writeScriptElement n s
runScriptElement n s@(Wait time) = writeScriptElement n s >> threadDelayMs time
runScriptElement n (Useraction msg) = putIndLn n $ "USERACTION " ++ "(" ++ quoted msg ++")"
@@ -90,7 +89,6 @@ writeScriptElementEnd n (CyclicCanMsg name id dat time ss) = putIndLn n $ "STOPC
writeScriptElement n (CanMsg name id dat) = putIndLn n $ "CANMSG " ++ bracketed name ++
" ID " ++ (bracketed . show) id ++
" DATA " ++ (bracketed . show) dat
-writeScriptElement n (Callscript file params) = putIndLn n $ "CALLSCRIPT " ++ file ++ " " ++(bracketed . show) params
writeScriptElement n (Wait time) = putIndLn n $ "WAIT " ++ bracketed (show time)
writeScriptElement n (ScriptTestCase (TestCase name
(DiagScriptMsg _ _ sent)
@@ -12,6 +12,7 @@ import Test.Framework (testGroup, Test)
import Test.Framework.Providers.HUnit (testCase)
import Text.Parsec.Error
import Util.RecursiveContents
+import qualified Diagnoser.PreProcessor as PP
scriptPath = "Tests/diagnoser/implemented"
@@ -34,9 +35,6 @@ diagnoserScripterTests = do
groupNumberNameAssertion <- assertionTest groupNumberNameResult (scriptPath ++ "/groupNumberName.skr")
waitSimpleAssertion <- assertionTest waitSimpleResult (scriptPath ++ "/waitSimple.skr")
useractionSimpleAssertion <- assertionTest useractionSimpleResult (scriptPath ++ "/useractionSimple.skr")
- callscriptSimpleAssertion <- assertionTest callscriptSimpleResult (scriptPath ++ "/callscriptSimple.skr")
- callscriptWithParameterAssertion <- assertionTest callscriptWithParameterResult (scriptPath ++ "/callscriptWithParameter.skr")
- callscriptWithParametersAssertion <- assertionTest callscriptWithParametersResult (scriptPath ++ "/callscriptWithParameters.skr")
canmsgSimpleAssertion <- assertionTest canmsgSimpleResult (scriptPath ++ "/canmsgSimple.skr")
canmsgCyclicAssertion <- assertionTest canmsgCyclicResult (scriptPath ++ "/canmsgCyclic.skr")
waitExample <- assertionTest allTrueResult "Tests/diagnoser/Beispiele_WAIT/EXAMPLE_kwp2000_test_with_WAIT.skr"
@@ -64,10 +62,6 @@ diagnoserScripterTests = do
[testCase "simple wait construct" waitSimpleAssertion],
testGroup "useraction"
[testCase "simple useraction construct" waitSimpleAssertion],
- testGroup "callscript"
- [testCase "simple callscript construct" callscriptSimpleAssertion,
- testCase "simple callscript construct with one Parameters" callscriptWithParameterAssertion,
- testCase "simple callscript construct with Parameters" callscriptWithParametersAssertion],
testGroup "canmsg"
[testCase "simple canmsg construct" canmsgSimpleAssertion,
testCase "cyclic canmsg construct" canmsgCyclicAssertion],
@@ -178,17 +172,6 @@ canmsgSimpleResult :: DiagScript -> Bool
canmsgSimpleResult (DiagScript [CanMsg "CAN_1" 0x6F1 [0x11,0x22,0x33,0x44]]) = True
canmsgSimpleResult _ = False
-callscriptSimpleResult :: DiagScript -> Bool
-callscriptSimpleResult (DiagScript [Callscript "EXAMPLE_Script_CALLSCRIPT_Target.skr" []]) = True
-
-callscriptWithParameterResult :: DiagScript -> Bool
-callscriptWithParameterResult (DiagScript [Callscript _ [_]]) = True
-callscriptWithParameterResult _ = False
-
-callscriptWithParametersResult :: DiagScript -> Bool
-callscriptWithParametersResult (DiagScript [Callscript _ [_,_,_]]) = True
-callscriptWithParametersResult _ = False
-
useractionSimpleResult :: DiagScript -> Bool
useractionSimpleResult (DiagScript [Useraction "Dieser Text wird als MsgBox angezeigt!"]) = True
useractionSimpleResult _ = False
@@ -240,6 +223,10 @@ generalAssertion parseResult checkResult =
assertionTest testAssertion file = do
f <- readFile file
+ -- scr <- PP.preProcess file -- check if tests still work when they run through the preprocessor first
+ -- let f = case scr of
+ -- (Right r) -> r
+ -- (Left l) -> ""
let s = SP.parseScript f
return $ generalAssertion s testAssertion
View
@@ -57,7 +57,6 @@ simpleExamples :: [ScriptElement]
simpleExamples =
[Wait 100
,Useraction "This is a Messagle"
- ,Callscript "/testfile.skr" [Parameter "name" [0x03], Parameter "name2" [0x03,0x04,0x05]]
,CanMsg "canmsg1" 0x000 [0x1,0x2,0x3]
,ScriptTestCase (TestCase "TestName"
(DiagScriptMsg (Just 1) (Just 2) [0x00,0x11])
Oops, something went wrong.

0 comments on commit af1e809

Please sign in to comment.