运用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，是因为可以将所有派生自该类的子类板卡的错误统计信息汇总起来。 将第二个层次抽象出来以后，再上一层的板卡类可以集成不同的位于第二层的父类，实现不同板卡不同的读写方式（接口是统一的，这样改动就会比较小，只需要修改继承关系就可以了。

 

太晚了，暂时写到这，办卡类的实现，以及后续自动平台功能扩展的架构构想放在后面一篇说吧。