TKE  3.6
Advanced code editor for programmers
bist Namespace Reference

Functions

 refresh args
 
 run
 
 run_test index ppass pfail perr
 
 runtime_string ms
 
 output msg ?tag?
 
 cancel
 
 initialize
 
 finish
 
 create
 
 text_select_test x y
 
 text_jump_to_test x y
 
 create_file
 
 validate_file value
 
 add_test_file name
 
 generate_file name
 
 create_test
 
 edit_file
 
 edit_test
 
 add_and_jump_to_test fname tname
 
 set_mode mb lbl val mode
 
 set_state w state
 
 on_select W x y
 
 handle_right_click W x y X Y
 
 on_destroy
 
 format_cell value
 
 save_options
 
 load_options
 
 get_selections
 
 set_selections selected
 
 label_clicked tbl col
 
 filter
 

Function Documentation

§ add_and_jump_to_test()

bist::add_and_jump_to_test   fname tname  

Definition at line 820 of file bist.tcl.

820  proc add_and_jump_to_test {fname tname} {
821 
822  # Add the file to the editor
823  set tab [add_test_file $fname]
824 
825  # Get the text widget from the tab
826  gui::get_info $tab tab txt
827 
828  # Find the test in the file
829  if {[set index [$txt search -regexp -- "proc\\s+$tname\\M" 1.0]] ne ""} {
830  ::tk::TextSetCursor $txt $index
831  }
832 
833  }

§ add_test_file()

bist::add_test_file   name  

Definition at line 708 of file bist.tcl.

708  proc add_test_file {name} {
709 
710  return [gui::add_file end [file join $::tke_dir tests $name.tcl] -sidebar 0 -remember 0 -savecommand [list bist::refresh]]
711 
712  }

§ cancel()

bist::cancel

Definition at line 309 of file bist.tcl.

309  proc cancel {} {
310 
311  variable data
312 
313  set data(run) 0
314 
315  }

§ create()

bist::create

Definition at line 389 of file bist.tcl.

389  proc create {} {
390 
391  variable data
392 
393  # If the BIST window already exists, do nothing
394  if {[winfo exists .bistwin]} {
395  return
396  }
397 
398  # Create images
399  set data(images,unchecked) [image create photo -file [file join $::tke_dir lib images unchecked.gif]]
400  set data(images,checked) [image create photo -file [file join $::tke_dir lib images checked.gif]]
401 
402  # Create the window
403  toplevel .bistwin
404  wm title .bistwin [msgcat::mc "Built-In Self Test"]
405 
406  # Create the main notebook
407  set data(widgets,nb) [ttk::notebook .bistwin.nb]
408 
409  # Add the regression setup frame
410  .bistwin.nb add [set sf [ttk::frame .bistwin.nb.sf]] -text [msgcat::mc "Setup"]
411 
412  ttk::frame $sf.tf
413  set data(widgets,tbl) [tablelist::tablelist $sf.tf.tl -columns [list 0 {} 0 [msgcat::mc "Name"] 0 [msgcat::mc "Run Count"] 0 [msgcat::mc "Pass Count"] 0 [msgcat::mc "Fail Count"] 0 {}] \
414  -treecolumn 1 -exportselection 0 -stretch all \
415  -borderwidth 0 -highlightthickness 0 \
416  -selectbackground blue -selectforeground white \
417  -xscrollcommand [list $sf.tf.hb set] -yscrollcommand [list $sf.tf.vb set]]
418  scroller::scroller $sf.tf.hb -orient horizontal -background white -foreground black -command [list $sf.tf.tl xview]
419  scroller::scroller $sf.tf.vb -orient vertical -background white -foreground black -command [list $sf.tf.tl yview]
420 
421  $sf.tf.tl columnconfigure 0 -name selected -editable 0 -resizable 0 -editwindow checkbutton \
422  -formatcommand [list bist::format_cell] -labelimage $data(images,unchecked) -labelcommand [list bist::label_clicked]
423  $sf.tf.tl columnconfigure 1 -name name -editable 0 -resizable 0 -formatcommand [list bist::format_cell]
424  $sf.tf.tl columnconfigure 2 -name count -editable 0 -resizable 0
425  $sf.tf.tl columnconfigure 3 -name pass -editable 0 -resizable 0
426  $sf.tf.tl columnconfigure 4 -name fail -editable 0 -resizable 0
427  $sf.tf.tl columnconfigure 5 -name test -hide 1
428 
429  bind [$data(widgets,tbl) bodytag] <Button-$::right_click> [list bist::handle_right_click %W %x %y %X %Y]
430 
431  grid rowconfigure $sf.tf 0 -weight 1
432  grid columnconfigure $sf.tf 0 -weight 1
433  grid $sf.tf.tl -row 0 -column 0 -sticky news
434  grid $sf.tf.vb -row 0 -column 1 -sticky ns
435  grid $sf.tf.hb -row 1 -column 0 -sticky ew
436 
437  pack $sf.tf -fill both -expand yes
438 
439  # Add the options frame
440  .bistwin.nb add [set of [ttk::frame .bistwin.nb.of]] -text [msgcat::mc "Options"]
441 
442  ttk::radiobutton $of.lrb -text [msgcat::mc "Run loops"] -variable bist::data(run_mode) -value "loop" -command {
443  bist::set_state .bistwin.nb.of.if disabled
444  bist::set_state .bistwin.nb.of.lf normal
445  }
446 
447  ttk::frame $of.lf
448  ttk::label $of.lf.lcl -text [format "%s: " [msgcat::mc "Loop count"]]
449  set data(widgets,loops) [ttk::spinbox $of.lf.lcsb -from 1 -to 1000 -increment 1.0]
450  ttk::label $of.lf.ltl -text [format "%s: " [msgcat::mc "Loop type"]]
451  ttk::menubutton $of.lf.ltmb -menu [menu .bistwin.ltPopup -tearoff 0]
452 
453  grid rowconfigure $of.lf 5 -weight 1
454  grid columnconfigure $of.lf 0 -minsize 20
455  grid columnconfigure $of.lf 1 -minsize 150
456  grid columnconfigure $of.lf 3 -weight 1
457  grid $of.lf.lcl -row 0 -column 1 -sticky news -padx 2 -pady 2
458  grid $of.lf.lcsb -row 0 -column 2 -sticky news -padx 2 -pady 2
459  grid $of.lf.ltl -row 1 -column 1 -sticky news -padx 2 -pady 2
460  grid $of.lf.ltmb -row 1 -column 2 -sticky news -padx 2 -pady 2
461 
462  ttk::radiobutton $of.irb -text [msgcat::mc "Run iterations"] -variable bist::data(run_mode) -value "iter" -command {
463  bist::set_state .bistwin.nb.of.lf disabled
464  bist::set_state .bistwin.nb.of.if normal
465  }
466 
467  ttk::frame $of.if
468  ttk::label $of.if.icl -text [format "%s: " [msgcat::mc "Iteration count"]]
469  set data(widgets,iters) [ttk::spinbox $of.if.icsb -from 1 -to 1000 -increment 1.0]
470  ttk::label $of.if.itl -text [format "%s: " [msgcat::mc "Selection method"]]
471  ttk::menubutton $of.if.itmb -menu [menu .bistwin.itPopup -tearoff 0]
472 
473  grid rowconfigure $of.if 5 -weight 1
474  grid columnconfigure $of.if 0 -minsize 20
475  grid columnconfigure $of.if 1 -minsize 150
476  grid columnconfigure $of.if 3 -weight 1
477  grid $of.if.icl -row 0 -column 1 -sticky news -padx 2 -pady 2
478  grid $of.if.icsb -row 0 -column 2 -sticky news -padx 2 -pady 2
479  grid $of.if.itl -row 1 -column 1 -sticky news -padx 2 -pady 2
480  grid $of.if.itmb -row 1 -column 2 -sticky news -padx 2 -pady 2
481 
482  pack $of.lrb -fill x -padx 2 -pady 2
483  pack $of.lf -fill x -padx 2 -pady 2
484  pack $of.irb -fill x -padx 2 -pady 2
485  pack $of.if -fill x -padx 2 -pady 2
486 
487  # Create loop mode menu
488  foreach {val lbl} [list \
489  "random" [msgcat::mc "Random"] \
490  "increment" [msgcat::mc "Incrementing order"] \
491  "decrement" [msgcat::mc "Decrementing order"]] {
492  set cmd [list bist::set_mode .bistwin.nb.of.lf.ltmb $lbl $val loop_mode]
493  .bistwin.ltPopup add radiobutton -label $lbl -variable bist::data(loop_mode) -value $val -command $cmd
494  }
495 
496  # Create iteration mode menu
497  foreach {val lbl} [list \
498  "random" [msgcat::mc "Random"] \
499  "increment" [msgcat::mc "Incrementing order"] \
500  "decrement" [msgcat::mc "Decrementing order"]] {
501  set cmd [list bist::set_mode .bistwin.nb.of.if.itmb $lbl $val iter_mode]
502  .bistwin.itPopup add radiobutton -label $lbl -variable bist::data(iter_mode) -value $val -command $cmd
503  }
504 
505  # Initialize UI state
506  set data(run_mode) "iter"
507  set data(loop_mode) "random"
508  set data(iter_mode) "random"
509  $data(widgets,loops) set 1
510  $of.lf.ltmb configure -text [msgcat::mc "Random"]
511  $data(widgets,iters) set 50
512  $of.if.itmb configure -text [msgcat::mc "Random"]
513  set_state $of.lf disabled
514 
515  # Add the results frame
516  .bistwin.nb add [set rf [ttk::frame .bistwin.nb.rf]] -text [msgcat::mc "Results"]
517 
518  ttk::labelframe $rf.of -text [msgcat::mc "Output"]
519  set data(widgets,output) [text $rf.of.t -state disabled -wrap none \
520  -relief flat -borderwidth 0 -highlightthickness 0 \
521  -xscrollcommand [list $rf.of.hb set] \
522  -yscrollcommand [list $rf.of.vb set]]
523  scroller::scroller $rf.of.hb -orient horizontal -background white -foreground black -command [list $rf.of.t xview]
524  scroller::scroller $rf.of.vb -orient vertical -background white -foreground black -command [list $rf.of.t yview]
525 
526  bind $rf.of.t <ButtonPress-$::right_click> [list bist::text_select_test %x %y]
527  bind $rf.of.t <ButtonRelease-$::right_click> [list bist::text_jump_to_test %x %y]
528 
529  grid rowconfigure $rf.of 0 -weight 1
530  grid columnconfigure $rf.of 0 -weight 1
531  grid $rf.of.t -row 0 -column 0 -sticky news
532  grid $rf.of.vb -row 0 -column 1 -sticky ns
533  grid $rf.of.hb -row 1 -column 0 -sticky ew
534 
535  pack $rf.of -fill both -expand yes
536 
537  # Add the main button frame
538  ttk::frame .bistwin.bf
539  set data(widgets,filter) [ttk::menubutton .bistwin.bf.filter -text [msgcat::mc "Filter"] -width 12 -menu .bistwin.filterPopup]
540  set data(widgets,refresh) [ttk::button .bistwin.bf.refresh -style BButton -text [msgcat::mc "Refresh"] -width 7 -command [list bist::refresh]]
541  set data(widgets,run) [ttk::button .bistwin.bf.run -style BButton -text [msgcat::mc "Run"] -width 7 -command [list bist::run]]
542  set data(widgets,runtype) [ttk::menubutton .bistwin.bf.runtype -menu .bistwin.runPopup -state disabled]
543 
544  # Pack the button frame
545  ttk::label .bistwin.bf.l0 -text [format "%s: " [msgcat::mc "Total"]]
546  set data(widgets,total) [ttk::label .bistwin.bf.tot -text "" -width 5]
547  ttk::label .bistwin.bf.l1 -text [format "%s: " [msgcat::mc "Passed"]]
548  set data(widgets,pass) [ttk::label .bistwin.bf.pass -text "" -width 5]
549  ttk::label .bistwin.bf.l2 -text [format "%s: " [msgcat::mc "Failed"]]
550  set data(widgets,fail) [ttk::label .bistwin.bf.fail -text "" -width 5]
551 
552  pack .bistwin.bf.l0 -side left -padx 2 -pady 2
553  pack .bistwin.bf.tot -side left -padx 2 -pady 2
554  pack .bistwin.bf.l1 -side left -padx 2 -pady 2
555  pack .bistwin.bf.pass -side left -padx 2 -pady 2
556  pack .bistwin.bf.l2 -side left -padx 2 -pady 2
557  pack .bistwin.bf.fail -side left -padx 2 -pady 2
558  pack .bistwin.bf.runtype -side right -padx 2 -pady 2
559  pack .bistwin.bf.run -side right -padx 2 -pady 2
560  pack .bistwin.bf.refresh -side right -padx 2 -pady 2
561  pack .bistwin.bf.filter -side right -padx 2 -pady 2
562 
563  # Pack the main UI elements
564  pack .bistwin.nb -fill both -expand yes
565  pack .bistwin.bf -fill x
566 
567  # Create output tags
568  $data(widgets,output) tag configure passed -elide 0
569  $data(widgets,output) tag configure failed -elide 0
570 
571  # Handle a window destruction
572  bind [$data(widgets,tbl) bodytag] <Button-1> [list bist::on_select %W %x %y]
573 
574  # Create testlist menus
575  menu .bistwin.filePopup -tearoff 0
576  .bistwin.filePopup add command -label [msgcat::mc "New Test File"] -command [list bist::create_file]
577  .bistwin.filePopup add command -label [msgcat::mc "New Test"] -command [list bist::create_test]
578  .bistwin.filePopup add separator
579  .bistwin.filePopup add command -label [msgcat::mc "Edit Test File"] -command [list bist::edit_file]
580 
581  menu .bistwin.testPopup -tearoff 0
582  .bistwin.testPopup add command -label [msgcat::mc "Edit Test"] -command [list bist::edit_test]
583 
584  menu .bistwin.filterPopup -tearoff 0
585  .bistwin.filterPopup add radiobutton -label [msgcat::mc "All"] -variable bist::data(filter) -value all -command [list bist::filter]
586  .bistwin.filterPopup add separator
587  .bistwin.filterPopup add radiobutton -label [msgcat::mc "Fail"] -variable bist::data(filter) -value fail -command [list bist::filter]
588  .bistwin.filterPopup add radiobutton -label [msgcat::mc "Pass"] -variable bist::data(filter) -value pass -command [list bist::filter]
589 
590  menu .bistwin.runPopup -tearoff 0
591  .bistwin.runPopup add radiobutton -label [msgcat::mc "Selected"] -variable bist::data(runtype) -value selected
592  .bistwin.runPopup add radiobutton -label [msgcat::mc "Failed"] -variable bist::data(runtype) -value failed
593 
594  # Handle the window close event
595  wm protocol .bistwin WM_DELETE_WINDOW [list bist::on_destroy]
596 
597  # Populate the testlist
598  refresh
599 
600  # Load the saved options (if any)
602 
603  }

§ create_file()

bist::create_file

Definition at line 651 of file bist.tcl.

651  proc create_file {} {
652 
653  toplevel .bistwin.namewin
654  wm title .bistwin.namewin [msgcat::mc "New Test Name"]
655  wm transient .bistwin.namewin .bistwin
656  wm resizable .bistwin.namewin 0 0
657 
658  ttk::frame .bistwin.namewin.f
659  ttk::label .bistwin.namewin.f.l -text [format "%s: " [msgcat::mc "Name"]]
660  ttk::entry .bistwin.namewin.f.e -validate key -validatecommand [list bist::validate_file %P]
661 
662  bind .bistwin.namewin.f.e <Return> [list .bistwin.namewin.bf.create invoke]
663 
664  pack .bistwin.namewin.f.l -side left -padx 2 -pady 2
665  pack .bistwin.namewin.f.e -side left -padx 2 -pady 2 -fill x
666 
667  ttk::frame .bistwin.namewin.bf
668  ttk::button .bistwin.namewin.bf.create -style BButton -text [msgcat::mc "Create"] -width 6 -command {
669  bist::generate_file [.bistwin.namewin.f.e get]
670  destroy .bistwin.namewin
671  } -state disabled
672  ttk::button .bistwin.namewin.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -width 6 -command {
673  destroy .bistwin.namewin
674  }
675 
676  pack .bistwin.namewin.bf.cancel -side right -padx 2 -pady 2
677  pack .bistwin.namewin.bf.create -side right -padx 2 -pady 2
678 
679  pack .bistwin.namewin.f -fill x
680  pack .bistwin.namewin.bf -fill x
681 
682  # Get the grab
683  ::tk::SetFocusGrab .bistwin.namewin .bistwin.namewin.f.e
684 
685  # Wait for the window to be destroyed
686  tkwait window .bistwin.namewin
687 
688  # Release the grab
689  ::tk::RestoreFocusGrab .bistwin.namewin .bistwin.namewin.f.e
690 
691  }

§ create_test()

bist::create_test

Definition at line 743 of file bist.tcl.

743  proc create_test {} {
744 
745  variable data
746 
747  # Get the selected row
748  set selected [$data(widgets,tbl) curselection]
749 
750  # Get the test name
751  set test [$data(widgets,tbl) cellcget $selected,name -text]
752 
753  # Get the test name
754  set row [lindex [$data(widgets,tbl) childkeys $selected] end]
755 
756  # Get the new test name
757  if {[regexp {run_test(\d+)} [$data(widgets,tbl) cellcget $row,name -text] -> num]} {
758  set name "run_test[expr $num + 1]"
759  }
760 
761  # Add the file to the editor
762  set tab [add_test_file $test]
763 
764  # Get the text widget from the tab
765  gui::get_info $tab tab txt
766 
767  # Get the position of the second to last right curly bracket
768  lassign [lrange [$txt tag ranges __curlyR] end-3 end-2] startpos endpos
769 
770  # Insert the test
771  $txt insert $endpos "\n\n proc $name {} {\n \n }"
772  ::tk::TextSetCursor $txt $endpos+4c
773 
774  # Save the file
776 
777  }

§ edit_file()

bist::edit_file

Definition at line 781 of file bist.tcl.

781  proc edit_file {} {
782 
783  variable data
784 
785  # Get the selected row
786  set selected [$data(widgets,tbl) curselection]
787 
788  # Get the diagnostic name
789  set fname [$data(widgets,tbl) cellcget $selected,name -text]
790 
791  # Add the file to the editor
792  set tab [add_test_file $fname]
793 
794  }

§ edit_test()

bist::edit_test

Definition at line 799 of file bist.tcl.

799  proc edit_test {} {
800 
801  variable data
802 
803  # Get the selected row
804  set selected [$data(widgets,tbl) curselection]
805 
806  # Get the test name
807  set tname [$data(widgets,tbl) cellcget $selected,name -text]
808 
809  # Get the diagnostic name
810  set parent [$data(widgets,tbl) parentkey $selected]
811  set fname [$data(widgets,tbl) cellcget $parent,name -text]
812 
813  # Add the file and jump to the text
814  add_and_jump_to_test $fname $tname
815 
816  }

§ filter()

bist::filter

Definition at line 1126 of file bist.tcl.

1126  proc filter {} {
1127 
1128  variable data
1129 
1130  switch $data(filter) {
1131  "all" {
1132  $data(widgets,output) tag configure passed -elide 0
1133  $data(widgets,output) tag configure failed -elide 0
1134  $data(widgets,filter) configure -text [format "%s: %s" [msgcat::mc "Filter"] [msgcat::mc "All"]]
1135  }
1136  "pass" {
1137  $data(widgets,output) tag configure passed -elide 0
1138  $data(widgets,output) tag configure failed -elide 1
1139  $data(widgets,filter) configure -text [format "%s: %s" [msgcat::mc "Filter"] [msgcat::mc "Pass"]]
1140  }
1141  "fail" {
1142  $data(widgets,output) tag configure passed -elide 1
1143  $data(widgets,output) tag configure failed -elide 0
1144  $data(widgets,filter) configure -text [format "%s: %s" [msgcat::mc "Filter"] [msgcat::mc "Fail"]]
1145  }
1146  }
1147 
1148  }

§ finish()

bist::finish

Definition at line 367 of file bist.tcl.

367  proc finish {} {
368 
369  variable testdir
370  variable data
371 
372  # Delete the temporary test directory
373  file delete -force $testdir
374 
375  # Save the run settings
377 
378  # Specify that we are done
379  set data(done) 1
380 
381  }

§ format_cell()

bist::format_cell   value  

Definition at line 956 of file bist.tcl.

956  proc format_cell {value} {
957 
958  variable data
959 
960  lassign [$data(widgets,tbl) formatinfo] key row col
961 
962  switch [$data(widgets,tbl) columncget $col -name] {
963  "selected" {
964  return ""
965  }
966  "name" {
967  if {[$data(widgets,tbl) parentkey $key] eq "root"} {
968  return [string totitle $value]
969  } else {
970  return $value
971  }
972  }
973  }
974 
975  return ""
976 
977  }

§ generate_file()

bist::generate_file   name  

Definition at line 716 of file bist.tcl.

716  proc generate_file {name} {
717 
718  # Open a file for writing
719  if {![catch { open [file join $::tke_dir tests $name.tcl] w} rc]} {
720 
721  puts $rc "namespace eval $name {"
722  puts $rc ""
723  puts $rc " proc run_test1 {} {"
724  puts $rc ""
725  puts $rc " }"
726  puts $rc ""
727  puts $rc "}"
728 
729  close $rc
730 
731  }
732 
733  # Add the file to the editor
734  add_test_file $name
735 
736  # Save the file
738 
739  }

§ get_selections()

bist::get_selections

Definition at line 1047 of file bist.tcl.

1047  proc get_selections {} {
1048 
1049  variable data
1050 
1051  set selected [list]
1052 
1053  # Get the selection information
1054  for {set i 0} {$i < [$data(widgets,tbl) size]} {incr i} {
1055  if {([$data(widgets,tbl) parentkey $i] ne "root") && [$data(widgets,tbl) cellcget $i,selected -text]} {
1056  lappend selected [$data(widgets,tbl) cellcget $i,test -text]
1057  }
1058  }
1059 
1060  return $selected
1061 
1062  }

§ handle_right_click()

bist::handle_right_click   W x y X Y  

Definition at line 898 of file bist.tcl.

898  proc handle_right_click {W x y X Y} {
899 
900  variable data
901 
902  lassign [tablelist::convEventFields $W $x $y] ::tablelist::W ::tablelist::x ::tablelist::y
903  set row [$data(widgets,tbl) containing $::tablelist::y]
904 
905  if {$row != -1} {
906 
907  # Set the selection to the current row
908  $data(widgets,tbl) selection clear 0 end
909  $data(widgets,tbl) selection set $row
910 
911  # Display the appropriate menu
912  if {[$data(widgets,tbl) parentkey $row] eq "root"} {
913  tk_popup .bistwin.filePopup $X $Y
914  } else {
915  tk_popup .bistwin.testPopup $X $Y
916  }
917 
918  }
919 
920  }

§ initialize()

bist::initialize

Definition at line 319 of file bist.tcl.

319  proc initialize {} {
320 
321  variable testdir
322  variable data
323  variable run_tests
324 
325  # Create the test directory pathname
326  set testdir [file join $::tke_home bist]
327 
328  # Delete the test directory if it still exists
329  file delete -force $testdir
330 
331  # Create the test directory
332  file mkdir $testdir
333 
334  # Add files to the test directory
335  for {set i 0} {$i < 5} {incr i} {
336  if {![catch { open [file join $testdir test$i.txt] w} rc]} {
337  puts $rc "This is test $i"
338  close $rc
339  }
340  }
341 
342  # Get the list of tests to run
343  set run_tests [list]
344  for {set i 0} {$i < [$data(widgets,tbl) size]} {incr i} {
345  if {[$data(widgets,tbl) cellcget $i,selected -text]} {
346  if {[set test [$data(widgets,tbl) cellcget $i,test -text]] ne ""} {
347  lappend run_tests [list $test $i]
348  }
349  }
350  }
351 
352  # If we are only supposed to rerun failures, adjust the list
353  if {$data(runtype) eq "failed"} {
354  set failed_tests [list]
355  foreach {startpos endpos} [$data(widgets,output) tag ranges failed] {
356  if {[regexp [format {%s\s+(\S+)\s*\.\.\.} [msgcat::mc "Running"]] [$data(widgets,output) get $startpos $endpos] -> test]} {
357  lappend failed_tests [list $test [lindex [lsearch -index 0 -inline $run_tests $test] 1]]
358  }
359  }
360  set run_tests $failed_tests
361  }
362 
363  }

§ label_clicked()

bist::label_clicked   tbl col  

Definition at line 1106 of file bist.tcl.

1106  proc label_clicked {tbl col} {
1107 
1108  variable data
1109 
1110  # Figure out the value of selected
1111  set sel [expr {[$data(widgets,tbl) columncget selected -labelimage] ne $data(images,checked)}]
1112  set img [expr {$sel ? $data(images,checked) : $data(images,unchecked)}]
1113 
1114  # Change the label image
1115  $data(widgets,tbl) columnconfigure selected -labelimage $img
1116 
1117  # Change the row images and values
1118  for {set i 0} {$i < [$data(widgets,tbl) size]} {incr i} {
1119  $data(widgets,tbl) cellconfigure $i,selected -text $sel -image $img
1120  }
1121 
1122  }

§ load_options()

bist::load_options

Definition at line 1000 of file bist.tcl.

1000  proc load_options {} {
1001 
1002  variable data
1003 
1004  if {![catch { tkedat::read [file join $::tke_home bist.tkedat] 0} rc]} {
1005 
1006  array set options $rc
1007 
1008  # Update the UI
1009  set data(run_mode) $options(run_mode)
1010  set data(loop_mode) $options(loop_mode)
1011  set data(iter_mode) $options(iter_mode)
1012 
1013  $data(widgets,loops) set $options(loops)
1014  $data(widgets,iters) set $options(iters)
1015 
1016  # Update UI state
1017  if {$data(run_mode) eq "loop"} {
1018  set_state .bistwin.nb.of.lf normal
1019  set_state .bistwin.nb.of.if disabled
1020  } else {
1021  set_state .bistwin.nb.of.lf disabled
1022  set_state .bistwin.nb.of.if normal
1023  }
1024 
1025  # Update menubuttons
1026  for {set i 0} {$i <= [.bistwin.ltPopup index end]} {incr i} {
1027  if {[.bistwin.ltPopup entrycget $i -value] eq $options(loop_mode)} {
1028  .bistwin.nb.of.lf.ltmb configure -text [.bistwin.ltPopup entrycget $i -label]
1029  }
1030  }
1031  for {set i 0} {$i <= [.bistwin.itPopup index end]} {incr i} {
1032  if {[.bistwin.itPopup entrycget $i -value] eq $options(iter_mode)} {
1033  .bistwin.nb.of.if.itmb configure -text [.bistwin.itPopup entrycget $i -label]
1034  }
1035  }
1036 
1037  # Set the selections
1038  set_selections $options(selected)
1039 
1040  }
1041 
1042  }

§ on_destroy()

bist::on_destroy

Definition at line 925 of file bist.tcl.

925  proc on_destroy {} {
926 
927  variable data
928 
929  catch {
930 
931  # If the regression is running we cannot be quit
932  if {!$data(done)} {
933 
934  # Cause the regression to stop
935  set data(run) 0
936 
937  return
938 
939  }
940 
941  # Delete the images
942  image delete $data(images,checked) $data(images,unchecked)
943 
944  # Saves the current options
946 
947  }
948 
949  # Delete the window
950  destroy .bistwin
951 
952  }

§ on_select()

bist::on_select   W x y  

Definition at line 867 of file bist.tcl.

867  proc on_select {W x y} {
868 
869  variable data
870 
871  lassign [tablelist::convEventFields $W $x $y] ::tablelist::W ::tablelist::x ::tablelist::y
872  lassign [split [$data(widgets,tbl) containingcell $::tablelist::x $::tablelist::y] ,] row col
873 
874  if {($row != -1) && ($col == 0)} {
875 
876  # Set the checkbutton accordingly
877  if {[$data(widgets,tbl) cellcget $row,selected -text]} {
878  $data(widgets,tbl) cellconfigure $row,selected -text [set value 0] -image [set img $data(images,unchecked)]
879  } else {
880  $data(widgets,tbl) cellconfigure $row,selected -text [set value 1] -image [set img $data(images,checked)]
881  }
882 
883  # If the row is a category, make all of the children selections match the parent's value
884  foreach child [$data(widgets,tbl) childkeys $row] {
885  $data(widgets,tbl) cellconfigure $child,selected -text $value -image $img
886  }
887 
888  # Set the run type to selected and disable the runtype
889  set data(runtype) "selected"
890  $data(widgets,runtype) configure -state disabled
891 
892  }
893 
894  }

§ output()

bist::output   msg ?tag?  

Definition at line 292 of file bist.tcl.

292  proc output {msg {tag ""}} {
293 
294  variable data
295 
296  $data(widgets,output) configure -state normal
297  if {$tag ne ""} {
298  $data(widgets,output) tag add $tag "end-1c linestart" end
299  }
300  $data(widgets,output) insert end $msg $tag
301  $data(widgets,output) configure -state disabled
302 
303  $data(widgets,output) see insert
304 
305  }

§ refresh()

bist::refresh   args  

Definition at line 45 of file bist.tcl.

45  proc refresh {args} {
46 
47  variable data
48  variable tests
49 
50  # If the BIST window exists, we don't need to do anything
51  if {![winfo exists .bistwin]} {
52  return
53  }
54 
55  # Get the list of selected diagnostics in the table
56  set selected [get_selections]
57 
58  # Load all of the BIST files
59  foreach bfile [glob -directory [file join $::tke_dir tests] *.tcl] {
60  if {[catch { source $bfile} rc]} {
61  puts $::errorInfo
62  }
63  }
64 
65  # Gather the list of tests to run
66  set tests [list]
67  foreach ns [namespace children] {
68  lappend tests {*}[info procs ${ns}::run_test*]
69  }
70 
71  # Organize the test items
72  set i 0
73  foreach test $tests {
74  lassign [string map {{::} { }} $test] dummy category name
75  lappend test_array($category) $name
76  incr i
77  }
78 
79  # Clear the tablelist
80  $data(widgets,tbl) delete 0 end
81 
82  # Add the test items to the tablelist
83  foreach category [lsort -dictionary [array names test_array]] {
84  set node [$data(widgets,tbl) insertchild root end [list 1 $category 0 0 0 ""]]
85  $data(widgets,tbl) rowconfigure $node -background grey
86  $data(widgets,tbl) cellconfigure $node,selected -image $data(images,checked)
87  foreach test [lsort -dictionary $test_array($category)] {
88  set cmd [join [list bist $category $test] ::]
89  set child [$data(widgets,tbl) insertchild $node end [list 1 $test 0 0 0 $cmd]]
90  $data(widgets,tbl) cellconfigure $child,selected -image $data(images,checked)
91  }
92  }
93 
94  # Collapse all tests
95  $data(widgets,tbl) collapseall
96 
97  # Sets the given selections
98  set_selections $selected
99 
100  }

§ run()

bist::run

Definition at line 104 of file bist.tcl.

104  proc run {} {
105 
106  variable tests
107  variable data
108  variable run_tests
109 
110  # Specify that the regression should run
111  set data(run) 1
112  set data(done) 0
113 
114  # Initialize the filter
115  set data(filter) "all"
116  filter
117 
118  # Initialize a few things first
119  initialize
120 
121  # Get the number of tests available to run
122  set testslen [llength $run_tests]
123  set err 0
124  set pass 0
125  set fail 0
126 
127  # Make sure that the results tab is displayed.
128  $data(widgets,nb) select 2
129 
130  # Allow the BIST to dump output to the output text widget
131  $data(widgets,output) configure -state normal
132  $data(widgets,output) delete 1.0 end
133  $data(widgets,output) configure -state disabled
134 
135  # Initialize the pass and fail widgets
136  $data(widgets,pass) configure -text 0
137  $data(widgets,fail) configure -text 0
138 
139  # Configure UI components
140  $data(widgets,refresh) configure -state disabled
141  $data(widgets,run) configure -text [msgcat::mc "Cancel"] -command [list bist::cancel]
142  $data(widgets,runtype) configure -state disabled
143 
144  update idletasks
145 
146  output "---------------------------------------------\n"
147  output [format "%s - %s\n\n" [msgcat::mc "RUNNING BIST"] [clock format [clock seconds]]]
148 
149  set start_time [clock milliseconds]
150 
151  if {$data(run_mode) eq "iter"} {
152  $data(widgets,total) configure -text [$data(widgets,iters) get]
153  set index 0
154  for {set i 0} {$i < [$data(widgets,iters) get]} {incr i} {
155  output [format {%s %4d: } [msgcat::mc "Iteration"] [expr $i + 1]]
156  switch $data(iter_mode) {
157  random {
158  if {![run_test [expr int( rand() * $testslen )] pass fail err]} {
159  break
160  }
161  }
162  increment {
163  if {![run_test $index pass fail err]} {
164  break
165  }
166  set index [expr ($index + 1) % $testslen]
167  }
168  decrement {
169  set index [expr ($index == 0) ? ($testslen - 1) : ($index - 1)]
170  if {![run_test $index pass fail err]} {
171  break
172  }
173  }
174  }
175  }
176  } elseif {$data(run_mode) eq "loop"} {
177  $data(widgets,total) configure -text [expr [$data(widgets,loops) get] * $testslen]
178  for {set i 0} {$i < [$data(widgets,loops) get]} {incr i} {
179  set tests [list]
180  for {set j 0} {$j < $testslen} {incr j} {
181  lappend tests $j
182  }
183  switch $data(loop_mode) {
184  random {
185  for {set j 0} {$j < $testslen} {incr j} {
186  set rn [expr int( rand() * $testslen )]
187  set val [lindex $tests $rn]
188  lset tests $rn [lindex $tests $j]
189  lset tests $j $val
190  }
191  }
192  decrement {
193  set tests [lreverse $tests]
194  }
195  }
196  output [format "\n%s %d\n\n" [msgcat::mc "Loop"] [expr $i + 1]]
197  for {set j 0} {$j < $testslen} {incr j} {
198  output [format {%s %4d: } [msgcat::mc "Test"] [expr $j + 1]]
199  if {![run_test [lindex $tests $j] pass fail err]} {
200  break
201  }
202  }
203  if {!$data(run)} {
204  break
205  }
206  }
207  }
208 
209  set stop_time [clock milliseconds]
210 
211  output [format "\n%s: %d, %s: %d\n\n" [msgcat::mc "PASSED"] $pass [msgcat::mc "FAILED"] $fail]
212  output [format "%s: %s\n" [msgcat::mc "Runtime"] [runtime_string [expr $stop_time - $start_time]]]
213  output "---------------------------------------------"
214 
215  # Configure UI components
216  $data(widgets,refresh) configure -state normal
217  $data(widgets,run) configure -text [msgcat::mc "Run"] -command [list bist::run]
218 
219  if {$fail == 0} {
220  $data(widgets,runtype) configure -state disabled
221  set data(runtype) "selected"
222  } else {
223  $data(widgets,runtype) configure -state normal
224  }
225 
226  # Wrap things up
227  finish
228 
229  }

§ run_test()

bist::run_test   index ppass pfail perr  

Definition at line 233 of file bist.tcl.

233  proc run_test {index ppass pfail perr} {
234 
235  upvar $ppass pass
236  upvar $pfail fail
237  upvar $perr err
238 
239  variable data
240  variable run_tests
241 
242  # Get the row and text to run
243  lassign [lindex $run_tests $index] test row
244 
245  # Get the row's parent
246  set par [$data(widgets,tbl) parentkey $row]
247 
248  # Increment the count cell for both the child and parent
249  $data(widgets,tbl) cellconfigure $row,count -text [expr [$data(widgets,tbl) cellcget $row,count -text] + 1]
250  $data(widgets,tbl) cellconfigure $par,count -text [expr [$data(widgets,tbl) cellcget $par,count -text] + 1]
251 
252  output [format {%s %-40s... } [msgcat::mc "Running"] $test]
253 
254  # Run the diagnostic and track the pass/fail status in the table
255  if {[catch { $test} rc]} {
256  incr fail
257  output [format " %s (%s)\n" [msgcat::mc "FAILED"] $rc] failed
258  logger::log $::errorInfo
259  $data(widgets,fail) configure -text $fail
260  $data(widgets,tbl) cellconfigure $row,fail -text [expr [$data(widgets,tbl) cellcget $row,fail -text] + 1]
261  $data(widgets,tbl) cellconfigure $par,fail -text [expr [$data(widgets,tbl) cellcget $par,fail -text] + 1]
262  } else {
263  incr pass
264  output [format " %s\n" [msgcat::mc "PASSED"]] passed
265  $data(widgets,pass) configure -text $pass
266  $data(widgets,tbl) cellconfigure $row,pass -text [expr [$data(widgets,tbl) cellcget $row,pass -text] + 1]
267  $data(widgets,tbl) cellconfigure $par,pass -text [expr [$data(widgets,tbl) cellcget $par,pass -text] + 1]
268  }
269 
270  # Allow any user events to be handled
271  update
272 
273  # Specify if we should continue to run
274  return $data(run)
275 
276  }

§ runtime_string()

bist::runtime_string   ms  

Definition at line 280 of file bist.tcl.

280  proc runtime_string {ms} {
281 
282  set hours [expr $ms / 3600000]
283  set minutes [expr ($ms - ($hours * 3600000)) / 60000]
284  set seconds [expr ($ms - ($hours * 3600000) - ($minutes * 60000)) / 1000.0]
285 
286  return [format "%d %s, %d %s, %g %s" $hours [msgcat::mc "hours"] $minutes [msgcat::mc "minutes"] $seconds [msgcat::mc "seconds"]]
287 
288  }

§ save_options()

bist::save_options

Definition at line 981 of file bist.tcl.

981  proc save_options {} {
982 
983  variable data
984 
985  # Get the values to save into an array
986  set options(run_mode) $data(run_mode)
987  set options(loop_mode) $data(loop_mode)
988  set options(iter_mode) $data(iter_mode)
989  set options(loops) [$data(widgets,loops) get]
990  set options(iters) [$data(widgets,iters) get]
991  set options(selected) [get_selections]
992 
993  # Write the options
994  catch { tkedat::write [file join $::tke_home bist.tkedat] [array get options] 0}
995 
996  }

§ set_mode()

bist::set_mode   mb lbl val mode  

Definition at line 837 of file bist.tcl.

837  proc set_mode {mb lbl val mode} {
838 
839  variable data
840 
841  # Update the menubutton
842  $mb configure -text $lbl
843 
844  # Update the mode value
845  set data($mode) $val
846 
847  }

§ set_selections()

bist::set_selections   selected  

Definition at line 1066 of file bist.tcl.

1066  proc set_selections {selected} {
1067 
1068  variable data
1069 
1070  set test_row -1
1071  set tsel_count 0
1072 
1073  for {set i 0} {$i < [$data(widgets,tbl) size]} {incr i} {
1074  if {[$data(widgets,tbl) parentkey $i] eq "root"} {
1075  if {$test_row != -1} {
1076  set sel [expr {[llength [$data(widgets,tbl) childkeys $test_row]] == $sel_count}]
1077  $data(widgets,tbl) cellconfigure $test_row,selected -text $sel -image [expr {$sel ? $data(images,checked) : $data(images,unchecked)}]
1078  incr tsel_count $sel
1079  }
1080  set test_row $i
1081  set sel_count 0
1082  } else {
1083  set test [$data(widgets,tbl) cellcget $i,test -text]
1084  set sel [expr {[lsearch $selected $test] != -1}]
1085  incr sel_count $sel
1086  $data(widgets,tbl) cellconfigure $i,selected -text $sel -image [expr {$sel ? $data(images,checked) : $data(images,unchecked)}]
1087  }
1088  }
1089 
1090  if {$sel_count != -1} {
1091  set sel [expr {[llength [$data(widgets,tbl) childkeys $test_row]] == $sel_count}]
1092  $data(widgets,tbl) cellconfigure $test_row,selected -text $sel -image [expr {$sel ? $data(images,checked) : $data(images,unchecked)}]
1093  incr tsel_count $sel
1094  }
1095 
1096  if {[llength [$data(widgets,tbl) childkeys root]] == $tsel_count} {
1097  $data(widgets,tbl) columnconfigure selected -labelimage $data(images,checked)
1098  } else {
1099  $data(widgets,tbl) columnconfigure selected -labelimage $data(images,unchecked)
1100  }
1101 
1102  }

§ set_state()

bist::set_state   w state  

Definition at line 851 of file bist.tcl.

851  proc set_state {w state} {
852 
853  # Set the current state
854  if {[catch { $w state [expr {($state eq "normal") ? "!disabled" : "disabled"}]}]} {
855  catch { $w configure -state $state}
856  }
857 
858  # Set the state of the child widgets
859  foreach child [winfo children $w] {
860  set_state $child $state
861  }
862 
863  }

§ text_jump_to_test()

bist::text_jump_to_test   x y  

Definition at line 631 of file bist.tcl.

631  proc text_jump_to_test {x y} {
632 
633  variable data
634 
635  # Get our row
636  set row [lindex [split [$data(widgets,output) index @$x,$y] .] 0]
637 
638  # If there is selected text, compare its to ours
639  if {([set endpos [lassign [$data(widgets,output) tag ranges sel] startpos]] ne "") && ([lindex [split $endpos .] 0] == $row)} {
640  lassign [string map {:: { }} [$data(widgets,output) get $startpos $endpos]] dummy fname tname
641  add_and_jump_to_test $fname $tname
642  }
643 
644  # Make sure that the selection is blown away no matter what
645  $data(widgets,output) tag remove sel 1.0 end
646 
647  }

§ text_select_test()

bist::text_select_test   x y  

Definition at line 610 of file bist.tcl.

610  proc text_select_test {x y} {
611 
612  variable data
613 
614  # Get the selected row
615  set row [lindex [split [$data(widgets,output) index @$x,$y] .] 0]
616 
617  # Clear the selection
618  $data(widgets,output) tag remove sel 1.0 end
619 
620  set pattern [format {%s \S+\s*\.\.\.} [msgcat::mc "Running"]]
621  if {[set index [$data(widgets,output) search -count length -regexp -- $pattern $row.0 $row.end]] ne ""} {
622  set start [expr {[string length [msgcat::mc "Running"]] + 1}]
623  $data(widgets,output) tag add sel "$index+${start}c" "$index+[expr $length - 3]c"
624  }
625 
626  }

§ validate_file()

bist::validate_file   value  

Definition at line 695 of file bist.tcl.

695  proc validate_file {value} {
696 
697  if {($value eq "") || [file exists [file join $::tke_dir tests $value.tcl]]} {
698  .bistwin.namewin.bf.create configure -state disabled
699  } else {
700  .bistwin.namewin.bf.create configure -state normal
701  }
702 
703  return 1
704  }