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 | ||||
} | ||||
} | ||||