defaria.com/Computers/code/testing/bin/SaliraTest.tcl

   1 namespace eval Test {
   2   # Test: This module contains the testing scaffolding necessary to implement
   3   #       testing in a consistant and easy manner.
   4
   5   # Functions & Variables
   6   namespace export      \
   7     CLI                 \
   8     Debug               \
   9     Display             \
  10     End                 \
  11     EndSuite            \
  12     Error               \
  13     Failed              \
  14     Log                 \
  15     Login               \
  16     LoginVxWorks        \
  17     Passed              \
  18     Start               \
  19     StartSuite          \
  20     Verbose             \
  21     Warning             \
  22     failure             \
  23     reason              \
  24     salira_prompt       \
  25     status              \
  26     success             \
  27     succeeded           \
  28     test_name
  29
  30   # Variables useful for testing
  31   variable status               0
  32   variable salira_prompt        "\# "
  33   variable success              $salira_prompt
  34   variable succeeded            "succeeded"
  35   variable reason               ""
  36   variable failure              "Error"
  37   variable total_tests_run
  38   variable total_tests_passed
  39   variable total_tests_failed
  40   variable test_name            ""
  41   variable leaveopen
  42
  43   # Internal state variables
  44   variable verbose
  45   variable debug
  46   variable test_base    "/dview/defaria_default/Tools/testing"
  47   variable logfile
  48   variable connection
  49   variable depth
  50   variable machine      "172.16.35.211"
  51
  52   # Globals
  53   global spawn_id
  54
  55   # Reporting procedures
  56   proc Error {args} {
  57     variable status
  58
  59     send_user "ERROR: [join $args]\n"
  60     set status 1
  61     exit 1;
  62   }
  63
  64   proc Warning {args} {
  65     send_user "WARNING: [join $args]\n"
  66   }
  67
  68   proc Verbose {args} {
  69     variable verbose
  70
  71     if {[info exist verbose]} {
  72       send_user "[join $args]\n"
  73     }
  74   }
  75
  76   proc Debug {args} {
  77     variable debug
  78
  79     if {[info exist debug]} {
  80       send_user "DEBUG: [join $args]\n"
  81     }
  82   }
  83
  84   proc Display {args} {
  85     send_user "[join $args]\n"
  86   }
  87
  88   # Logging routines
  89   proc Log {args} {
  90     variable logfile
  91
  92     Verbose [join $args]
  93     puts $logfile [join $args]
  94     flush $logfile
  95   }
  96
  97   proc Passed {args} {
  98     variable total_tests_passed
  99     variable test_name
 100
 101     if {[info exist total_tests_passed]} {
 102       incr total_tests_passed
 103     } else {
 104       set total_tests_passed 1
 105     }
 106
 107     Log "Test PASSED: $test_name [join $args]"
 108   }
 109
 110   proc Failed {args} {
 111     variable total_tests_failed
 112     variable test_name
 113
 114     if {[info exist total_tests_failed]} {
 115       incr total_tests_failed
 116     } else {
 117       set total_tests_failed 1
 118     }
 119
 120     Log "Test FAILED: $test_name [join $args]"
 121   }
 122
 123   # Login routines
 124   proc Login {machine {username root} {password root}} {
 125     global spawn_id
 126
 127     variable connection
 128     variable test_base
 129     variable logfile
 130     variable depth
 131
 132     # Turn off logging
 133     log_user 0
 134
 135     # Check to see if we are already connected
 136     if {[info exist connection]} {
 137       # Already connected
 138       return $connection
 139     }
 140
 141     # Establish connection
 142     spawn "telnet" $machine
 143     set connection $spawn_id
 144
 145     Debug "Logging into $machine..."
 146
 147     # Look for Login prompt
 148     expect {
 149       "Login:" {
 150       }
 151       timeout {
 152         Error "$machine is not responding"
 153       }
 154     }
 155
 156     send $username\r
 157     expect {
 158       "Password:" {
 159         send $password\r
 160       }
 161       timeout {
 162         Error "Password prompt not issued"
 163       }
 164     }
 165
 166     expect {
 167       "\# " {
 168         Debug "Logged into $machine"
 169       }
 170       timeout {
 171         Error "$machine appears to be dead"
 172       }
 173     }
 174
 175     if {![info exist depth]} {
 176       set depth 1
 177     } else {
 178       incr depth
 179     }
 180
 181     return $connection
 182   }
 183
 184   proc Logout {} {
 185     variable depth
 186     variable leaveopen
 187
 188     if {[info exist leaveopen] && $leaveopen == 1} {
 189       return
 190     }
 191
 192     for {set i 0} {$i < $depth} {incr i} {
 193       send "logout\r"
 194     }
 195   }
 196
 197   proc LoginVxWorks {{username root} {password root}} {
 198     Debug "Logging into VxWorks console..."
 199
 200     send "cc 1\r"
 201
 202     expect {
 203       "login: " {
 204         # Success
 205       }
 206       default {
 207         Error "Fatal error: Unable to switch to VxWorks console"
 208         exit 1
 209       }
 210     }
 211
 212     # Due to a bug we need to hit return one more time
 213     send \r
 214
 215     expect {
 216       "login: " {
 217         # Success
 218       }
 219       default {
 220         Error "Fatal error: Unable to switch to VxWorks console"
 221         exit 1
 222       }
 223     }
 224
 225     # OK now we are read to login
 226     send $username\r
 227
 228     expect {
 229       "Password:" {
 230         # Success
 231       }
 232       default {
 233         Error "Fatal error: VxWorks did not issue a password prompt!"
 234         exit 1
 235       }
 236     }
 237
 238     send $password\r
 239
 240     expect {
 241       -gl "-\> " {
 242         # Success
 243       }
 244       default {
 245         Error "Fatal error: Unable to switch to VxWorks console"
 246         exit
 247       }
 248     }
 249
 250     if {![info exist depth]} {
 251       set depth 1
 252     } else {
 253       incr depth
 254     }
 255
 256     Debug "Logged into VxWorks console"
 257   }
 258
 259   proc StartSuite {} {
 260     variable test_base
 261     variable logfile
 262     variable leaveopen
 263
 264     # Start logfile
 265     set leaveopen 1
 266
 267     set date_n_time     [clock format [clock seconds] -format "%m-%d-%Y-%H-%M"]
 268     set logfilename     "$test_base/results/testrun-$date_n_time.log"
 269     set logfile         [open $logfilename w]
 270
 271     Log ">>>\tStart test run [clock format [clock seconds]]"
 272   }
 273
 274   proc Start {{name} {to_machine $Test::machine}} {
 275     variable logfile
 276     variable machine
 277     variable reason
 278     variable result
 279     variable test_base
 280     variable test_name
 281     variable total_tests_run
 282
 283     global spawn_id
 284
 285     set test_name $name
 286     set machine $to_machine
 287     set result 0
 288     set reason ""
 289
 290     # For individual test attempt to Login. Note if StartSuite was
 291     # called then we will already be connected so Login will simply
 292     # return
 293     Login $machine
 294
 295     # $logfile will be already opened if StartSuite was called. If not
 296     # then we are running a single test so open a logfile per test case
 297     if {[info exists logfile] == 0} {
 298       set scriptname [string range [info script] 0 \
 299                        [expr [string last "." [info script]] - 1]]
 300       set logfilename   "$scriptname.log"
 301       set logfile       [open $logfilename w]
 302     }
 303
 304     Log ">\tStart test $test_name [clock format [clock seconds]]"
 305
 306     if {[info exists total_tests_run]} {
 307       incr total_tests_run
 308     } else {
 309       set total_tests_run 1
 310     }
 311
 312     return $spawn_id
 313   }
 314
 315   proc End {} {
 316     variable result
 317     variable reason
 318     variable test_name
 319
 320     if {$result == 0} {
 321       Passed $reason
 322     } else {
 323       Failed $reason
 324     }
 325
 326     Log ">\tEnd test $test_name [clock format [clock seconds]]"
 327
 328     Logout
 329   }
 330
 331   proc EndSuite {} {
 332     variable total_tests_run
 333     variable total_tests_passed
 334     variable total_tests_failed
 335
 336     # Set to zero any undefined variables
 337     if {![info exist total_tests_run]} {
 338       set total_tests_run 0
 339     }
 340     if {![info exist total_tests_passed]} {
 341       set total_tests_passed 0
 342     }
 343     if {![info exist total_tests_failed]} {
 344       set total_tests_failed 0
 345     }
 346
 347     Log ">>>\tEnd test run [clock format [clock seconds]]"
 348     Log "========================="
 349     Log "Tests run:\t$total_tests_run"
 350     Log "Tests passed:\t$total_tests_passed"
 351     Log "Tests failed:\t$total_tests_failed"
 352     Log "========================="
 353
 354     set leaveopen 0
 355     Logout
 356   }
 357
 358   proc CLI {cmd {success ""}} {
 359     if {$success == ""} {
 360       set success $Test::salira_prompt
 361     }
 362
 363     send "$cmd\r"
 364
 365     expect {
 366       $success {
 367         return
 368       } "Error: Bad command" {
 369         set Test::result 1
 370         Log "Bad command $cmd encountered"
 371         End
 372       } timeout {
 373         set Test::result 1
 374         Log "Unable to execute $cmd - expecting $success"
 375         End
 376       }
 377     }
 378   }
 379 }