Un débogueur pour tcl

 

GM - 22/08/2009 : Les deux principales fonctionnalités d'un débogueur sont: 1) l'exécution du programme pas à pas ( et pour chaque pas, obtenir la valeur des variables), 2) faire la correspondance avec l'instruction du fichier source pour informer l'utilisateur du déroulement du programme.

Principe de fonctionnement:

L'exécution pas à pas est assurée par la commande trace

  trace add execution source enterstep "dbg::db 0"
  source 'fichier_a_deboguer'

Avant l'exécution de chaque instruction du fichier, la procédure dgb::db est appellée. C'est dans cette procédure que le programme est arreté par la demande d'une instruction à l'utilisateur (mode pas à pas), ou poursuivi (mode continu) jusqu'au prochain point d'arrêt. Ceci est valable pour les scripts tcl, pour les scripts tk, le programme entre dans la boucle d'attente des événements, et la trace sur la commande source n'a plus d'effet. Pour cela la trace est appliquée sur chaque procédure, mais une seule procédure ne peut être tracée à la fois. En effet si une procédure tracée, fait appel à la procédure B, la trace se poursuit dans la procédure B, mais si la procédure B est également tracée, il y a pour chaque instruction, deux appels à la procédure 'dbg::db'. C'est pour cela que la procédure en cours de trace (ptrace) est remplacée par la nouvelle (laproc).

  catch { trace remove execution $ptrace enterstep "dbg::db 1" }
  trace add execution $laproc enterstep "dbg::db 1"
  set ptrace $laproc

Le lien avec le fichier source est assuré par la commande 'info frame' (tcl version 8.5), qui permet de retrouver la ligne et le fichier ou se trouve l'instruction source. A noter que pour le déboguage de scripts tk, il faut retrouver la procédure concernée de cette ligne pour la mettre en trace.

  set niv [info frame]
  set niv [expr $niv -3]

Le niveau d'exécution de l'instruction est donné par [info frame], auquel il faut retirer 3 (pour les commandes info frame, if {$type<2)}, et proc db::dbg) pour obtenir le niveau par rapport au programme source.

  set infoniv [info frame $niv]
  while { [lindex $infoniv 1] != "source" } {
    incr niv -1
    set infoniv [info frame $niv]
    }
  set chemfic [lindex $infoniv 5]
  set ligne  [lindex $infoniv 3]

La commande [info frame niveau] retourne alors des informations de type 'source' contenant notamment la ligne et le nom du fichier source. Dans le cas d'instructions imbriquées, il faut remonter au niveau du sommet de la hiéarchie des instructions pour obtenir une information de type 'source' contenant le nom du fichier source.

Voici un petit programme complet pour tester la méthode, mais il permet déjà de déboguer les scripts tcl et tk répartis sur un ou plusieurs fichiers sources.

  namespace eval dbg {
    variable arrets ""     ;# fichier et ligne pour arret execution
    variable mode  1       ;# 0=continu  1=pas à pas
    variable etat 0        ;# 0=sequentiel  1=boucle d'événements
    variable code ""       ;# code adapté pour deboguer
    variable lesVars ""    ;# liste des variables à observer
    variable ptrace ""     ;# procedure en cours de trace
    }

  #=======================================
  proc dbg::db { type commande operation } {
  #---------------------------------------
  # Procédure appellée avant execution chaque instruction du code source
  #-----------------------------------------------
  variable mode
  variable arrets
  variable lesVars
  variable etat

  if {$type<2 } {
    #... fichier et numéro ligne de la commande...
    set niv [info frame]
    set niv [expr $niv -3]
    set infoniv [info frame $niv]

    while { [lindex $infoniv 1] != "source" } {
      incr niv -1
      set infoniv [info frame $niv]
      }
    set chemfic [lindex $infoniv 5]
    set ligne  [lindex $infoniv 3]
    set fic [file tail $chemfic]

    #...libellé commande...
    set pos [lsearch $infoniv "cmd" ]
    if { $pos > 0} {
      set insts [lindex $infoniv [expr $pos+1]]
      set inst [lindex [split $insts \n] 0]
      }

    set arret 0
    if { $mode==1 } { set arret 1 } \
    else {
      set nom [lindex $arrets 0]
      set idl [lindex $arrets 1]
      #puts "  nom=$nom idl=$idl idl=$idl"
      if { $nom==$fic && $idl==$ligne } { set arret 1 }
      }
    } \
  else {
    set fic "?????"
    set ligne 0
    set inst ""
    set arret 1
    }
  if { $arret==1 } {
    foreach var $lesVars {
      if [ uplevel 1 array exists $var] { uplevel 1 parray [list $var] } \
      elseif { [catch {
	uplevel 1 [string map [list VAR $var] {puts "  VAR = [set VAR]"}]  }  msg] } {
	puts "  $var = $msg"
	}
      }

    puts [format "%-15s %d: %s" $fic $ligne $inst]

    while { 1 }  {
      puts -nonewline ">"
      flush stdout
      gets stdin answer
      set cmd   [lindex [split $answer] 0]
      set argum [lindex [split $answer] 1]

      switch $cmd {
	"p" - "print" {
	  if [ uplevel 1 array exists $argum] { uplevel 1 parray [list $argum] } \
	  elseif { [catch {
	    uplevel 1 [string map [list VAR $argum] {puts "VAR = [set VAR]"}] } msg]  } {
	    puts "  $argum = $msg"
	    }
	  }
	"n" - "next" - {} {
	  set mode 1
	  return
	  }
	"c" - "cont" { # mode continu jusque prochain arret
	  set mode 0
	  return
	  }
	"a" - "add" { # ajouter variable
	  lappend lesVars $argum
	  }
	"b" - "break" { # mettre le point d'arret
	  set arrets [list $argum  [lindex [split $answer] 2]]
	  if {$etat==1 } {placerTrace }
	  }
	"r" - "remove" { # retirer variable
	  set pos [lsearch $lesVars $argum]
	  if {$pos>=0} { set lesVars [lreplace  $lesVars $pos $pos] }
	  }

	"vv" {  # voir les noms des variables suivies
	  puts -nonewline "variables suivies: "
	  foreach var $lesVars {
	    puts -nonewline "$var  "
	    }
	   puts " "
	  }
	"vb" {  # voir le point d'arret
	  puts  "arret=[lindex $arrets 0] : ligne [lindex $arrets 1]"
	  }
	}
      }
    }
  }
  #======================
  proc dbg::pause {} {
  db 2 {} {}
  }
  #===============================
  proc dbg::placerTrace { } {
  #-------------------------------
  # met en trace la procédure à la ligne et fichier
  # donné par le point d'arret
  #---------------------------------------
  variable arrets
  variable ptrace

  set fic [lindex $arrets 0 ]
  if { ![file exists $fic] } { return }
  set ligne [lindex $arrets 1]
  set f [open $fic r]
  set ftxt [read $f ]
  close $f
  set ltxt [split $ftxt \n]
  set laproc ""
  for {set n $ligne} {$n>0} {incr n -1} {
    set txt [lindex $ltxt $n]
    set txt [string trimleft $txt]
    regsub -all \x20+ $txt " " txt
    set insts [split $txt]
    if { [lindex $insts 0]=="proc" } {
      set laproc [lindex $insts 1]
      break
      }
    }
  if { $laproc != "" } {
    catch { trace remove execution $ptrace enterstep "dbg::db 1" }
    trace add execution $laproc enterstep "dbg::db 1"
    set ptrace $laproc
    }
  }
  ######################################
  set f [lindex $argv 0]
  if {$f==""} {
    puts "syntaxe: debug.tcl nomFichier"
    return
    }
  trace add execution source enterstep "dbg::db 0"
  # lancement du programme à deboguer
  set argv0 $f
  source $f
  # si script tk, entre dans boucle événements
  dbg::placerTrace
  trace remove execution source enterstep "dbg::db 0"
  catch {bind all <Control-b> "dbg::pause" }
  set dbg::etat 1

Il présente encore deux défauts: - Les procédures déclarées à l'intérieur d'un 'namespace' ne sont pas détectées, donc non suivies en déboguage tk. - les instructions sur plusieurs lignes avec le caractère \ ne sont pas correctement repérées dans le fichier source.

Utilisation dans une console:

Le programme démarre d'office en mode pas à pas et s'arrete à la première instruction trouvée. La 'main' est donnée à l'utilisateur pour les commandes suivantes:

la touche ctrl-b permet de rendre la main au cas ou le programme est entré dans la boucle d'événements alors qu'il n'y a pas de point d'arrêt.

exemple avec les sources de 'ezdit'

Evolution:

Si la méthode s'avère fonctionnelle, il serait intéressant d'intégrer ou mettre en relation ce programme avec un éditeur de texte afin de remplacer le suivi d'exécution dans la console par un suivi direct dans l'éditeur de texte.