En Tcl il n'est pas toujours très intuitif et simple de gérer les erreurs, j'ai donc programmé une procédure pour faire cela.
Ce code ne fonctionne qu'avec Tcl 8.5 ! Pour Tcl 8.4 vous pouvez utiliser la librairies mkGeneric (http://mkextensions.sf.net) !
Exemple:
Pour les utilisateurs un peu plus poussé vous pouvez spécifiez des codes d'erreur après le catch comme ceci:
Vous pouvez aussi générez vos propres codes d'erreur avec throw :-)
Ce code ne fonctionne qu'avec Tcl 8.5 ! Pour Tcl 8.4 vous pouvez utiliser la librairies mkGeneric (http://mkextensions.sf.net) !
tcl
# try Script ?catch Pattern CatchScript ...? ?catch DefaultCatchScript? ?finally FinallyScript?
#
# Cette fonction a pour but d'intercepter les erreurs Tcl simplement, lorsque
# vous utilisez try, le Script est exécuté, s'il génère une erreur il cherche un
# catchScript correspondant au type d'erreur spécifié dans Pattern en se
# basant sur une recherche avec des jokers comme string match.
#
# S'il n'en trouve pas il exécute le DefaultCatchScript, s'il n'est pas
# spécifié il ignore l'erreur. Puis à la fin il exécute le FinallyScript dans
# tous les cas (si votre script génère une erreur).
#
# Si jamais votre CatchScript génère une erreur elle est propagée, si votre
# FinallyScript génère une erreur elle est propagée en prioritée.
#
# L'erreur générée par votre Script est stockée dans $::errorMsg, vous possédez
# donc trois variables pour afficher l'erreur: $::errorMsg, $::errorInfo et
# $::errorCode.
proc try {script args} {
# On parse $args pour sortir un tableau des pattern de catch, $arrayCatchs.
# Chaque entrée du tableau est un pattern sauf les valeurs _default et
# _finally qui sont réservées.
set arrayCatchs(_default) [list]
set arrayCatchs(_finally) [list]
set foundPattern 0
set catchErr 0
for {set i 0} {$i <= [llength $args]} {incr i} {
lassign [lrange $args $i [expr {$i + 2}]] current pattern code
if {$current eq "catch"} {
if { ($code eq "catch") || ($code eq "") || ($code eq "finally")} {
set arrayCatchs(_default) $pattern
} else {
set arrayCatchs($pattern) $code
}
}
if {$current eq "finally"} {
set arrayCatchs(_finally) $pattern
}
}
# On exécute le script et on voit s'il retourne une erreur.
# Si c'est le cas alors on doit regarder si on a un pattern qui correspond
# au code d'erreur retourné et mettre le script à éxécuté dans $catchScript.
switch -- [catch [list uplevel 1 $script] scriptRes scriptOpt] {
1 {
foreach pattern [array names arrayCatchs] {
if { [string match $pattern [dict get $scriptOpt -errorcode]] } {
set catchScript $arrayCatchs($pattern)
set foundPattern 1
}
}
if {!$foundPattern} {
set catchScript $arrayCatchs(_default)
}
set ::errorMsg $scriptRes
}
2 {return -code return}
3 {return -code break}
4 {return -code continue}
0 {return -code ok $scriptRes}
}
# A partir de maintenant, notre script a retourné une erreur, et on a le code
# a éxécuté en cas d'erreur dans $catchScript. On doit donc éxécuter notre
# catchScript, s'il retourne une erreur on devra la propager, de même
# pour continue et break.
if { [set catchStatus [catch [list uplevel 1 $catchScript] catchRes catchOpt]] } {
if { $catchStatus eq 1 } {set catchErr 1}
}
if { [catch [uplevel 1 $arrayCatchs(_finally)] finallyRes finallyOpt] } {
# En cas d'erreur dans le catch on exécute le finally AVANT de
# propager l'erreur du catch car si il y a une erreur dans le
# le finally on doit la propager en prioritée.
return -options $finallyOpt
}
if {$catchErr} {
return -options $catchOpt
} else {
switch -- $catchStatus {
0 {return -code ok $catchRes}
2 {return -code return}
3 {return -code break}
4 {return -code continue}
}
}
}
# throw ?errorCode? ?errorMsg? ?errorInfo?
#
# Cette commande est identique à error sauf que vous ne spécifiez pas
# les arguments dans le même ordre. Elle est utile utilisée en parralèle avec
# try car vous pouvez spécifiez un code d'erreur spécifique pour try.
#
proc throw {errorCode args} {
lassign $args errorMsg errorInfo
return -code error -errorinfo $errorInfo -errorcode $errorCode $errorMsg
}
Exemple:
tcl
try {
set fileID [open monfichier.txt]
puts $fileID "LOL"
close $fileID
} catch {
puts "Erreur lors de l'écriture dans le fichier: $::errorMsg"
} finally {
puts "Ce code sera exécuté même si le code dans catch est erroné!"
}
Pour les utilisateurs un peu plus poussé vous pouvez spécifiez des codes d'erreur après le catch comme ceci:
tcl
try {
expr {100/0}
} catch "ARITH*" {
puts "Erreur mathématique: $::errorCode ($::errorMsg)"
} catch {
puts "Autre erreur: $::errorCode ($::errorMsg)"
}
Vous pouvez aussi générez vos propres codes d'erreur avec throw :-)
