IPSIS_C11.tcl
103 lines
| 4.2 KiB
| application/x-tcl
|
TclLexer
| r2 | #!/usr/bin/tclsh | |||
| # Exceptions should be thrown by value and catched by reference. | ||||
| # Moreover a rethrow must be done with throw; | ||||
| proc createThrowMachine {line initState} { | ||||
| set machine [dict create name "throw" keywordLine $line state $initState bracesCounter 0 firstKeyword ""] | ||||
| return $machine | ||||
| } | ||||
| proc createCatchMachine {line initState} { | ||||
| set machine [dict create name "catch" keywordLine $line state $initState bracesCounter 0 catchedException ""] | ||||
| return $machine | ||||
| } | ||||
| foreach fileName [getSourceFileNames] { | ||||
| set machines [list] | ||||
| set lastIdentifier "" | ||||
| set prev1 "" | ||||
| set prev2 "" | ||||
| set prev3 "" | ||||
| foreach token [getTokens $fileName 1 0 -1 -1 {throw catch new leftbrace rightbrace greater and identifier rightparen semicolon}] { | ||||
| set type [lindex $token 3] | ||||
| set line [lindex $token 1] | ||||
| if {$type == "identifier"} { | ||||
| set lastIdentifier [lindex $token 0] | ||||
| } | ||||
| if {$type == "throw"} { | ||||
| lappend machines [createThrowMachine $line "beforeThrow"] | ||||
| } elseif {$type == "catch"} { | ||||
| lappend machines [createCatchMachine $line "waitingForLeftBrace"] | ||||
| } | ||||
| set machinesToKeep [list] | ||||
| foreach m $machines { | ||||
| set keepMachine 1 | ||||
| dict with m { | ||||
| if {$name == "throw"} { | ||||
| if {$state == "beforeThrow" && $type == "throw"} { | ||||
| set state "catchFirstKeyword" | ||||
| } elseif {$state == "catchFirstKeyword"} { | ||||
| if {$type == "semicolon"} { | ||||
| # This is a rethrow | ||||
| set keepMachine 0 | ||||
| } else { | ||||
| set firstKeyword $type | ||||
| set state "waitForEndOfThrow" | ||||
| } | ||||
| } elseif {$state == "waitForEndOfThrow"} { | ||||
| if {$type == "leftbrace"} { | ||||
| # This is an exception specification | ||||
| set keepMachine 0 | ||||
| } elseif {$type == "semicolon"} { | ||||
| # This is a throw, check that the first keyword isn't | ||||
| # new or & | ||||
| if {$firstKeyword == "new" || $firstKeyword == "and"} { | ||||
| report $fileName $keywordLine "Exceptions should be thrown by value. Not allocated with new or dereferenced with &." | ||||
| } | ||||
| set keepMachine 0 | ||||
| } | ||||
| } | ||||
| } elseif {$name == "catch"} { | ||||
| if {$state == "waitingForLeftBrace" && $type == "leftbrace"} { | ||||
| set state "insideCatch" | ||||
| if {$prev2 == "identifier" && $prev1 == "rightparen"} { | ||||
| set catchedException $lastIdentifier | ||||
| if {$prev3 != "and"} { | ||||
| report $fileName $keywordLine "Exceptions should be catched by reference (exception catched: $catchedException)" | ||||
| } | ||||
| } | ||||
| } elseif {$state == "insideCatch"} { | ||||
| if {$type == "leftbrace"} { | ||||
| incr bracesCounter | ||||
| } elseif {$type == "rightbrace"} { | ||||
| if {$bracesCounter > 0} { | ||||
| incr bracesCounter -1 | ||||
| } else { | ||||
| set keepMachine 0 | ||||
| } | ||||
| } elseif {$prev2 == "throw" && $prev1 == "identifier" && $type == "semicolon"} { | ||||
| if {$lastIdentifier == $catchedException} { | ||||
| report $fileName $line "Exceptions should be rethrown with 'throw;' instead of 'throw ${catchedException};'" | ||||
| } | ||||
| } | ||||
| } | ||||
| } | ||||
| } | ||||
| if {$keepMachine} { | ||||
| lappend machinesToKeep $m | ||||
| } | ||||
| } | ||||
| set machines $machinesToKeep | ||||
| set prev3 $prev2 | ||||
| set prev2 $prev1 | ||||
| set prev1 $type | ||||
| } | ||||
| } | ||||
