运用ITcl实现基于Tcl的板级自动化测试平台搭建(beta)
最近需要进行基于板级的FPGA测试工作，由于需要联合四块不同的板卡同时进行工作，而每块板卡的寄存器访问方式又各不相同，所以进行测试工作时操作比价繁琐。现在，前期手动测试工作基本完毕，下一步是开发自动测试脚本，这里主要一个需求就是，为了使得所有的case格式可以比较统一且简单清晰，同时能够有详细的错误记录，需要在这个板级的自动测试环境上下点功夫。经过几天的努力和尝试，这个脚本环境基本上有了一个大概的框架。
由于设备相关，fpga的测试工作不能像使用开发板那样方便（jtag访问），必须通过设备软件系统进行寄存器的访问。各类板卡的访问环境又不尽相同，一套板卡有一套方法，所以对多块板卡进行联合测试的时候就显得非常繁琐。这里先介绍一下大致的设备系统结构。我们的设备有一个主控的板卡进行整个设备的控制，设备上又可以插多块子板卡，子板卡上也有板卡级别的主控cpu进行控制。主控板卡可以通过网口的方式连接到网络中，而每块板卡也可以通过主控板卡进行桥接访问。手动测试中，一般通过telnet的方式连接到我们的设备上。设备上有许多软件工具，实际上我们也是通过这些软件工具传输我们的命令进行相关的操作。
思考以后，觉得可以运用一下面向对象方法将一些操作分层，这样，经过封装以后，顶层的接口可以统一，底下的实现可以各不相同；同时，某些有共性的操作可以达到复用的效果，这样日后开发扩展就会比较方便。其实，tcl本身并不是一门面向对象的语言，不过幸好其扩展性很强，Itcl模块在一般的tcl版本中都直接集成了，可以通过Itcl实现面向对象的编程。
这里介绍整个脚本平台的构架和思路。
首先，从最低层的角度来看，我们可能需要通过telnet的方式连接到设备上的系统进行寄存器访问，也可能直接调用本地的应用进行寄存器的访问。这样，我就可以设计两种访问方式的类，一种是通过telnet方式访问设备主cpu的类，代码如下：
package require Itcl #-------------------------------------------------------------------- #this class will set up one telnet handle(connect to EC) #each time you make create an object of this Class or its subClass, #tcl will set up an individual handle for each object #-------------------------------------------------------------------- itcl::class EC { private common EC_connect_num 0 protected variable host 135.252.101.1 protected variable telnet_port 23 protected variable user {root} protected variable password {bugaosuni} protected variable host_prompt "root@:~#" protected variable chan_array #----------------------------------------------------------------- #set up telnet handle by constructor,so once you create object or #subobject of this class, a diff telnet handle will be set up #----------------------------------------------------------------- constructor {} { if [catch {set telnet_handle [telnet_login $host $telnet_port $user $password $host_prompt]} err] { puts stderr "$err" return } set chan_array(type) telnet set chan_array(id) $telnet_handle set chan_array(prompt) $host_prompt #set chan_array(prompt) $chan_prompt incr EC_connect_num puts "establish one ec telnet connection..." puts "..." puts "Total telnet connection number of EC is: $EC_connect_num" } destructor { incr EC_connect_num -1 close $chan_array(id) puts "destructor one EC telnet connection" } }
（先吐槽一下，博客园的代码插入竟然不支持tcl...）
当通过EC这个类创建对象的时候，脚本会自动建立一个telnet的连接工作，，然后我们就可以通过返回的句柄进行进一步的读写操作。
第二个类的实现比较长，但抽象出来看其实很简单，继承EC这个类，创建对象的时候通过父类完成telnet的
package require Itcl#---------------------------------------------------------------- #this class inherit from EC, #just change some global variable to fix my implementation, #because wr_rd_cmd is protected method here, so user need wrap #this class and use it #---------------------------------------------------------------- itcl::class dbgCut { inherit EC protected variable app_pwd "/???/???/???" protected variable dbgCut_prompt "???????>" protected variable slot_num 2 protected variable dev "N/A" private common 20p200_err_cnt 0 constructor {} {EC::constructor} { puts "dbgCut" set chan_array(prompt) $dbgCut_prompt if [catch {set rdata [chan_issue_cmd chan_array $app_pwd ]} err] { puts stderr "$err" return } } destructor {EC::destructor} protected method io_write_cmd {addr val} { set dbgCutThru_1 "!dbgCutThru (flts 0 otumach 1 " set dbgCutThru_2 $slot_num set dbgCutThru_3 ") " set dbgCutThru $dbgCutThru_1$dbgCutThru_2$dbgCutThru_3 set bar "_2" set val _$val set tt1 "\"drvdbg kitewrite__" set tt2 "\" " return $dbgCutThru$tt1$addr$val$bar$tt2 } protected method io_read_cmd {addr} { set dbgCutThru_1 "!dbgCutThru (flts 0 otumach 1 " set dbgCutThru_2 $slot_num set dbgCutThru_3 ") " set dbgCutThru $dbgCutThru_1$dbgCutThru_2$dbgCutThru_3 set bar "_2" set tt1 "\"drvdbg kiteread__" set tt2 "\" " return $dbgCutThru$tt1$addr$bar$tt2 } #copy from yinghuic, need check here #public mm {args} protected method rd_wr_cmd {args} { #parray chan_array ##args check and assigned set args_num [llength $args] puts "$args" puts "$args_num" if { $args_num < 2 } { ##error set msg_err "error: The number of arguments in proc mm should be no less than 2" log_puts $msg_err error $msg_err $::errorInfo } set args_1st [lindex $args 0] set args_ind [string range $args_1st 0 1] set args_rw [string range $args_1st 2 end] if ![string equal $args_ind "--" ] { ##error set msg_err "error: The indication of mm should be -- instead of $args_ind" error $msg_err $::errorInfo } set args_addr [lindex $args 1] ##args_addr validated here set args_num [expr $args_num-2] if [string equal $args_rw "rdl" ] { if {$args_num >1 } { ##error set msg_err "error: more arguments than need in $args" error $msg_err $::errorInfo } else { if {$args_num == 1} { ##length validate here set args_len [lindex $args 2] } #set cmd "mm $args" set cmd [io_read_cmd $args_addr] if [catch {set rdata [chan_issue_cmd chan_array $cmd ]} err] { set msg_err "error: $err" error $msg_err $::errorInfo } log_puts $rdata return $rdata } } elseif [string equal $args_rw "wrl" ] { if {$args_num == 1} { ##args_data validate here ##send command to host set args_data [lindex $args 2] #set cmd "mm $args" set cmd [io_write_cmd $args_addr $args_data] if [catch {set rdata [chan_issue_cmd chan_array $cmd ] } err] { set msg_err "error: $err" error $msg_err $::errorInfo } log_puts $rdata return $rdata } else { ##error set msg_err "error: more arguments than need in mm -- wrl $args_data" error $msg_err $::errorInfo } } else { ##error set msg_err "error: unkown command :$args_rw " error $msg_err $::errorInfo } } protected method reg_check {addr val} { set read_str "" set rd_addr "" set rd_val "" # 0 -- no err 1 -- err occur set err_flag 0 set raw_data [rd_wr_cmd --rdl $addr] regexp {dbgCut> kite read reg (0x[0-9a-zA-Z]+) on bar 2: data = (0x[0-9a-zA-Z]+)} $raw_data read_str rd_addr rd_val set tmp_1 [format $addr] set tmp_2 [format $rd_addr] set tmp_3 [format $val] set tmp_4 [format $rd_val] if {($tmp_1 == $tmp_2) && ($tmp_3 == $tmp_4)} { puts "read register address: $rd_addr, value is: $rd_val" set err_flag 0 return [list $err_flag $rd_addr $rd_val] } else { log_puts "err> dev $dev, slot $slot_num ) reg_chk $addr is error!" log_puts "err> expect : addr is $addr , data is $val" log_puts "err> return val:read address is $rd_addr, read data is $rd_val" set err_flag 1 incr 20p200_err_cnt return [list $err_flag $rd_addr $rd_val] } } public method check_20p200_error_cnt {} { puts "total 20p200 err cnt is : $20p200_err_cnt" return $20p200_err_cnt } protected method clear_total_20p200_error_cnt {} { puts "the total 20p200 error count has been clear!!!" set 20p200_err_cnt 0 } }
第二个层次实际是将telnet以后的软件命令进行了一次封装，并提供了一些方法供外部以及子类使用，这里注意 common这个变量的使用，实际作用类似于c++中的静态变量，这里用静态变量作为err cnt，是因为可以将所有派生自该类的子类板卡的错误统计信息汇总起来。 将第二个层次抽象出来以后，再上一层的板卡类可以集成不同的位于第二层的父类，实现不同板卡不同的读写方式（接口是统一的，这样改动就会比较小，只需要修改继承关系就可以了。
太晚了，暂时写到这，办卡类的实现，以及后续自动平台功能扩展的架构构想放在后面一篇说吧。
