Changeset 2068 for trunk

Timestamp:

Jan 26, 2011, 5:58:26 PM (14 years ago)

Author:

braffert

Message:

Small fixes for regression tester

Location:

trunk/tester

Files:

• tclIndex (modified) (1 diff)
• test.tcl (modified) (3 diffs)
• tester.tcl (modified) (2 diffs)
• testtree.tcl (modified) (9 diffs)

trunk/tester/tclIndex

@@ -62 +62 @@
 set auto_index(::Rappture::ResultsPage::_reorder) [list source [file join $dir resultspage.tcl]]
 set auto_index(::Rappture::ResultsPage::resultset) [list source [file join $dir resultspage.tcl]]
+set auto_index(::Rappture::Tester::TestBuilder) [list source [file join $dir testbuilder.tcl]]
+set auto_index(::Rappture::Tester::TestBuilder::tool) [list source [file join $dir testbuilder.tcl]]
+set auto_index(::Rappture::Tester::TestBuilder::constructor) [list source [file join $dir testbuilder.tcl]]
 set auto_index(::Rappture::Tester::selectionHandler) [list source [file join $dir tester.tcl]]
 set auto_index(::Rappture::Tester::regoldenize) [list source [file join $dir tester.tcl]]
+set auto_index(::Rappture::Tester::makeTest) [list source [file join $dir tester.tcl]]
 set auto_index(::Rappture::Tester::TestTree) [list source [file join $dir testtree.tcl]]
 set auto_index(::Rappture::Tester::TestTree::constructor) [list source [file join $dir testtree.tcl]]
+set auto_index(::Rappture::Tester::TestTree::destructor) [list source [file join $dir testtree.tcl]]
 set auto_index(::Rappture::Tester::TestTree::testdir) [list source [file join $dir testtree.tcl]]
 set auto_index(::Rappture::Tester::TestTree::toolxml) [list source [file join $dir testtree.tcl]]

trunk/tester/test.tcl

@@ -80 +80 @@
     itcl::delete object $_toolobj
     itcl::delete object $_testobj
-    if {$_ran} {
+    if {$_ran && $_testobj != $_runobj} {
         itcl::delete object $_runobj
     }
@@ -193 +193 @@
 # USAGE: getResult
 #
-# Returns the result of the test - either Pass, Fail, or Error.  Throws
-# an error if the test has not been ran.
+# Returns the result of the test - either Pass, Fail, or Error.  Returns
+# an empty string if the test has not been ran.
 # ----------------------------------------------------------------------
 itcl::body Rappture::Tester::Test::getResult {} {
-    if {!$_ran} {
-        error "Test has not yet been ran."
-    }
     return $_result
 }
@@ -294 +291 @@
 itcl::body Rappture::Tester::Test::run {} {
     # Delete existing library if rerun
-    if {$_ran} {
+    if {$_ran && $_result != "Error"} {
         itcl::delete object $_runobj
     }

trunk/tester/tester.tcl

@@ -65 +65 @@
         exit 1
     }
-} elseif {![file isdirectory $params(-testdir)]} {
-    puts "Test directory \"$params(-testdir)\" does not exist"
+# If given test directory does not exist, create it.
+} elseif {![file exists $params(-testdir)]} {
+    file mkdir $params(-testdir)
+} else {
+    puts "Non-directory file exists at test location \"$params(-testdir)\""
     exit 1
 }
@@ -74 +77 @@
 # ----------------------------------------------------------------------
 wm title . "Rappture Regression Tester"
+
+menu .mb
+menu .mb.file -tearoff 0
+.mb add cascade -label "File" -underline 0 -menu .mb.file
+.mb.file add command -label "Select tool" -underline 7 \
+    -command {set params(-tool) [tk_getOpenFile]
+              .tree configure -toolxml $params(-tool)}
+.mb.file add command -label "Select test directory" -underline 12 \
+    -command {set params(-testdir) [tk_chooseDirectory]
+              .tree configure -testdir $params(-testdir)}
+.mb.file add command -label "Exit" -underline 1 -command {destroy .}
+. configure -menu .mb
+
 panedwindow .pw
 

trunk/tester/testtree.tcl

@@ -46 +46 @@
     protected method getLeaves {{id 0}}
     protected method getSelected {}
-    protected method populate {}
+    protected method populate {args}
     protected method runSelected {}
     protected method runTest {id} 
@@ -116 +116 @@
         error "no -toolxml configuration option given."
     }
+
 }
 
@@ -135 +136 @@
 # ----------------------------------------------------------------------
 itcl::configbody Rappture::Tester::TestTree::testdir {
-    if {$itk_option(-toolxml) != ""} {
-        populate
+    if {[file isdirectory $itk_option(-testdir)]} {
+        if {$itk_option(-toolxml) != ""} {
+            populate
+        }
+    } else {
+        error "Test directory \"$itk_option(-testdir)\" does not exist"
     }
 }
@@ -146 +151 @@
 # tree if -toolxml is changed, but only if -testdir has already been
 # defined.
+# ----------------------------------------------------------------------
 itcl::configbody Rappture::Tester::TestTree::toolxml {
-    if {$itk_option(-testdir) != ""} {
-        populate
+    if {[file exists $itk_option(-toolxml)]} {
+        if {$itk_option(-testdir) != ""} {
+            populate
+        }
+    } else {
+        error "Tool \"$itk_option(-testdir)\" does not exist"
     }
 }
@@ -194 +204 @@
 # added later for the given tree node id.  Mainly needed to update the
 # result from Fail to Pass after regoldenizing a test.  If no id is 
-# given, return the test associated with the currently focused node.
+# given, refresh all tests and search the test directory again to check
+# for new tests.
 # ----------------------------------------------------------------------
 itcl::body Rappture::Tester::TestTree::refresh {args} {
     if {[llength $args] == 0} {
-         set id [$itk_component(treeview) index focus]
+        foreach id [getLeaves] {
+            refresh $id
+        }
+        populate -noclear
     } elseif {[llength $args] == 1} {
         set id [lindex $args 0]
+        if {[lsearch -exact [getLeaves] $id] == -1} {
+            error "given id $id is not a leaf node."
+        }
+        set test [getTest $id]
+        setData $id [list result [$test getResult] test $test]
     } else {
         error "wrong # args: should be refresh ?id?"
     }
-    if {[lsearch -exact [getLeaves] $id] == -1} {
-         error "given id $id is not a leaf node."
-    }
-    set test [getTest $id]
-    setData $id [list result [$test getResult] test $test]
 }
 
@@ -267 +281 @@
 
 # ----------------------------------------------------------------------
-# USAGE: populate
+# USAGE: populate ?-noclear?
 #
 # Used internally to insert nodes into the treeview for each test xml
@@ -273 +287 @@
 # information at path test.label.  Relies on the autocreate treeview
 # option so that branch nodes need not be explicitly created.  Deletes
-# any existing contents.
-# ----------------------------------------------------------------------
-itcl::body Rappture::Tester::TestTree::populate {} {
-    foreach id [getLeaves] {
-        itcl::delete object [getTest $id]
-    }
-    $itk_component(treeview) delete 0
+# any existing contents unless -noclear is given as an argument.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Tester::TestTree::populate {args} {
+    if {[lsearch $args -noclear] == -1} {
+        foreach id [getLeaves] {
+            itcl::delete object [getTest $id]
+        }
+        $itk_component(treeview) delete 0
+        $itk_component(treeview) selection clearall
+    }
     # TODO: add an appropriate icon
     set icon [Rappture::icon molvis-3dorth]
@@ -286 +303 @@
         set lib [Rappture::library $testxml]
         set testpath [$lib get test.label]
-        if {$testpath != ""} {
+        if {$testpath != "" && \
+            [$itk_component(treeview) find -full $testpath] == ""} {
             set test [Rappture::Tester::Test ::#auto \
                 $itk_option(-toolxml) $testxml]
@@ -296 +314 @@
     $itk_component(treeview) open -recurse root
     # TODO: Fix width of main treeview column
+    updateLabel
 }