+ Either call this function from within a testcase for a testcase specific + stub, or outside a testcase for a file-wide stub. + + @author Peter Harper + @creation-date 24 July 2001 +} { + global aa_stub_sequence + global aa_stub_names + global aa_testcase_id + + if {[info exists aa_testcase_id]} { + # + # Runtime testcase stub. + # If a stub for this procedure hasn't already been defined, take a copy + # of the original procedure and add it to the aa_stub_names list. + # + if {[lsearch -exact $aa_stub_names $proc_name] == -1} { + lappend aa_stub_names $proc_name + proc ${proc_name}_unstubbed [info args $proc_name] [info body $proc_name] + } + set aa_stub_sequence($proc_name) 1 + proc $proc_name [info args $proc_name] " + global aa_stub_sequence + global aa_testcase_id + set sequence_id \$aa_stub_sequence\($proc_name\) + incr aa_stub_sequence\($proc_name\) + $new_body + " + return + } else { + # + # File wide stub. + # + if {![nsv_exists aa_file_wide_stubs [info script]]} { + nsv_set aa_file_wide_stubs "[info script]" {} + } + nsv_lappend aa_file_wide_stubs "[info script]" [list $proc_name $new_body] + } +} + +ad_proc aa_unstub { + proc_name +} { + @author Peter Harper + @creation-date 24 July 2001 +} { + proc $proc_name [info args $proc_name] [info body ${proc_name}_unstubbed] + return +} + +ad_proc -public aa_register_init_class { + init_class_id + init_class_desc + constructor + destructor +} { + Registers a initialisation class to be used by one or more testcases. An + initialisation class can be assigned to a testcase via the + aa_register_testcase API.
+
+ An initialisation constructor is called once before + running a set of testcases, and the descructor called once + upon completion of running a set of testcases.
+ The idea behind this is that it could be used to perform data intensive + operations that shared amoungst a set if testcases. For example, mounting + an instance of a package. This could be performed by each testcase + individually, but this would be highly inefficient if there are any + significant number of them. +
+ Better to let the acs-automated-testing infrastructure call + the init_class code to set the package up, run all the tests, then call + the descructor to unmount the package. + @author Peter Harper + @creation-date 04 November 2001 +} { + # + # Work out the package key + # + set package_root [file join [acs_root_dir] packages] + set package_rel [string replace [info script] \ + 0 [string length $package_root]] + set package_key [lindex [file split $package_rel] 0] + # + # First, search the current list of init_classes. If an old version already + # exists, replace it with the new version. + # + set lpos 0 + set found_pos -1 + foreach init_class [nsv_get aa_test init_classes] { + if {[lindex $init_class 0] == $init_class_id && + [lindex $init_class 1] == $package_key} { + nsv_set aa_test init_classes [lreplace [nsv_get aa_test init_classes] \ + $lpos $lpos \ + [list $init_class_id $package_key \ + $init_class_desc \ + [info script] \ + $constructor $destructor]] + set found_pos $lpos + break + } + incr lpos + } + # + # If we haven't already replaced an existing entry, append the new + # entry to the list. + # + if {$found_pos == -1} { + nsv_lappend aa_test init_classes [list $init_class_id $package_key \ + $init_class_desc \ + [info script] \ + $constructor $destructor] + } + + # + # Define the functions. Note the destructor upvars into the + # aa_runseries function to gain visibility of all the variables + # the constructor has exported. + # + ad_proc _${package_key}__i_$init_class_id {} " + aa_log \"Running \\\"$init_class_id\\\" initialisation class constructor\" + $constructor + " + ad_proc _${package_key}__d_$init_class_id {} " + upvar _aa_exports _aa_exports + foreach v \$_aa_exports(\[list $package_key $init_class_id\]) { + upvar \$v \$v + } + $destructor + " +} + +ad_proc -public aa_register_component { + component_id + component_desc + body +} { + Registers a re-usable code component. Provide a component identifier, + description and component body code. +
+ This is useful for re-using code that sets up / clears down, data common + to many testcases. + @author Peter Harper + @creation-date 28 October 2001 +} { + # + # Work out the package key + # + set package_root [file join [acs_root_dir] packages] + set package_rel [string replace [info script] \ + 0 [string length $package_root]] + set package_key [lindex [file split $package_rel] 0] + # + # First, search the current list of components. If an old version already + # exists, replace it with the new version. + # + set lpos 0 + set found_pos -1 + foreach component [nsv_get aa_test components] { + if {[lindex $component 0] == $component_id && + [lindex $component 1] == $package_key} { + nsv_set aa_test components [lreplace [nsv_get aa_test components] \ + $lpos $lpos \ + [list $component_id $package_key \ + $component_desc \ + [info script] \ + $body]] + set found_pos $lpos + break + } + incr lpos + } + # + # If we haven't already replaced an existing entry, append the new + # entry to the list. + # + if {$found_pos == -1} { + nsv_lappend aa_test components [list $component_id $package_key \ + $component_desc \ + [info script] \ + $body] + } + +# set munged_body [subst {uplevel 1 {$body}}] + ad_proc _${package_key}__c_$component_id {} $body +} + +ad_proc -public aa_call_component { + component_id +} { + Executes the chunk of code associated with the component_id.
+ Call this function from within a testcase body only.
+ @author Peter Harper
+ @creation-date 28 October 2001
+} {
+ global aa_package_key
+ set body ""
+
+ #
+ # Search for the component body
+ #
+ foreach component [nsv_get aa_test components] {
+ if {$component_id == [lindex $component 0] &&
+ $aa_package_key == [lindex $component 1]} {
+ set body [lindex $component 4]
+ }
+ }
+
+ #
+ # If the component exists, execute the body code in the testcases stack
+ # level.
+ #
+ if {$body != ""} {
+ aa_log "Running component $component_id"
+ uplevel 1 "_${aa_package_key}__c_$component_id"
+ return
+ } else {
+ error "Unknown component $component_id, package $aa_package_key"
+ }
+}
+
+ad_proc -public aa_register_case {
+ {-cats {}}
+ {-init_classes {}}
+ {-on_error {}}
+ testcase_id
+ testcase_desc
+ args
+} {
+ Registers a testcase with the acs-automated-testing system. The testcase may be
+ associated with one or more categories using the -cats flag, eg:
+ aa_register_case -cats {
+ ...category1...
+ ...category2...
+ } -init_classes {
+ ...init_class1...
+ ...init_class2...
+ } -on_error {
+ ...on-error message...
+ } my_test_id {
+ ...code block one...
+ } {
+ ...code block two...
+ }
+
+ An optional message to display on if the test fails can be provided (see above). +
+ Specify a testcase_id, and description. All other arguments are assumed + to be one or more bodys to be executed. + @author Peter Harper + @creation-date 24 July 2001 +} { + + # + # Work out the package_key. + # + set package_root [file join [acs_root_dir] packages] + set package_rel [string replace [info script] \ + 0 [string length $package_root]] + set package_key [lindex [file split $package_rel] 0] + + # + # Print warnings for any unknown categories. + # + set filtered_cats {} + foreach category $cats { + if {[string trim $category] != ""} { + if {[lsearch [nsv_get aa_test categories] $category] == -1} { + ns_log warning "acs-automated-testing: Unknown testcase category $category" + } + lappend filtered_cats $category + } + } + set cats $filtered_cats + + # + # Print warnings for any unknown init_classes. We actually mask out + # any unknown init_classes here, so we don't get any script errors later. + # + set filtered_inits {} + foreach init_class $init_classes { + if {[string trim $init_class] != ""} { + set found 0 + foreach init_class_info [nsv_get aa_test init_classes] { + if {$init_class == [lindex $init_class_info 0]} { + set found 1 + } + } + if {!$found} { + ns_log warning "acs-automated-testing: Unknown init class $init_class" + } else { + lappend filtered_inits $init_class + } + } + } + set init_classes $filtered_inits + + # + # First, search the current list of test cases. If an old version already + # exists, replace it with the new version. + # + set lpos 0 + set found_pos -1 + foreach case [nsv_get aa_test cases] { + if {[lindex $case 0] == $testcase_id && + [lindex $case 3] == $package_key} { + nsv_set aa_test cases [lreplace [nsv_get aa_test cases] $lpos $lpos \ + [list $testcase_id $testcase_desc \ + [info script] $package_key \ + $cats $init_classes $on_error $args]] + set found_pos $lpos + break + } + incr lpos + } + # + # If we haven't already replaced an existing entry, append the new + # entry to the list. + # + if {$found_pos == -1} { + nsv_lappend aa_test cases [list $testcase_id $testcase_desc \ + [info script] $package_key \ + $cats $init_classes $on_error $args] + } + + if {[llength $init_classes] == 0} { + set init_class_code "" + } else { + set init_class_code " + global aa_init_class_logs + upvar 2 _aa_exports _aa_exports + foreach init_class \[list $init_classes\] { + foreach v \$_aa_exports(\[list $package_key \$init_class\]) { + upvar 2 \$v \$v + } + foreach logpair \$aa_init_class_logs(\[list $package_key \$init_class\]) { + aa_log_result \[lindex \$logpair 0\] \[lindex \$logpair 1\] + } + } + " + } + ad_proc _${package_key}__$testcase_id {} " + $init_class_code + set _aa_export {} + set body_count 0 + foreach testcase_body \[list $args\] { + aa_log \"Running testcase body \$body_count\" + set catch_val \[catch \"eval \[list \$testcase_body\]\" msg\] + if {\$catch_val} { + aa_log_result \"fail\" \"$testcase_id (body \$body_count): Error during execution: \$msg\" + } + incr body_count + } + " +} + +ad_proc -public aa_export_vars { + args +} { + Called from a initialisation class constructor or a component to + explicitly export the specified variables to the current testcase. +} { + uplevel " + foreach v $args { + upvar \$v \$v + uplevel 1 \"lappend _aa_export \$v\" + } + " +} + +ad_proc aa_runseries { + -quiet:boolean + {-testcase_id ""} + by_package_key + by_category +} { + Runs a series of testcases.
+ Runs all cases if both package_key and + category are blank, otherwise it uses the package and/or category to + select which testcases to run. + @author Peter Harper + @creation-date 24 July 2001 +} { + global aa_run_quietly_p + global aa_init_class_logs + global aa_in_init_class + + set aa_run_quietly_p $quiet_p + # + # Work out the list of initialisation classes. + # + set testcase_ids {} + if {$testcase_id != ""} { + lappend testcase_ids $testcase_id + foreach testcase [nsv_get aa_test cases] { + if {$testcase_id == [lindex $testcase 0]} { + set package_key [lindex $testcase 3] + set init_classes [lindex $testcase 5] + foreach init_class $init_classes { + set classes([list $package_key $init_class]) 1 + } + } + } + } else { + foreach testcase [nsv_get aa_test cases] { + set testcase_id [lindex $testcase 0] + set package_key [lindex $testcase 3] + set categories [lindex $testcase 4] + set init_classes [lindex $testcase 5] + if {($by_package_key == "" || ($by_package_key == $package_key)) && \ + ($by_category == "" || ([lsearch $categories $by_category] != -1))} { + lappend testcase_ids $testcase_id + foreach init_class $init_classes { + set classes([list $package_key $init_class]) 1 + } + } + } + } + # + # Run each initialisation script. Keep a list of the exported variables + # by each initialisation script so each testcase (and destructor) can + # correctly upvar to gain visibility of them. + # + if {[info exists classes]} { + foreach initpair [array names classes] { + set package_key [lindex $initpair 0] + set init_class [lindex $initpair 1] + set _aa_export {} + set aa_init_class_logs([list $package_key $init_class]) {} + set aa_in_init_class [list $package_key $init_class] + _${package_key}__i_$init_class + set _aa_exports([list $package_key $init_class]) $_aa_export + } + } + set aa_in_init_class "" + + # + # Run each testcase + # + foreach testcase_id $testcase_ids { + aa_run_testcase $testcase_id + } + + # + # Run each initialisation destructor script. + # + if {[info exists classes]} { + foreach initpair [array names classes] { + set package_key [lindex $initpair 0] + set init_class [lindex $initpair 1] + set aa_in_init_class [list $package_key $init_class] + _${package_key}__d_$init_class + } + } + set aa_in_init_class "" +} + + +ad_proc aa_run_testcase { + testcase_id +} { + @author Peter Harper + @creation-date 24 July 2001 +} { + global aa_stub_names + global aa_testcase_id + global aa_testcase_test_id + global aa_testcase_fails + global aa_testcase_passes + global aa_package_key + global aa_init_class_logs + upvar exports exports + + set aa_stub_names {} + set aa_testcase_id $testcase_id + set aa_testcase_test_id 0 + set aa_testcase_fails 0 + set aa_testcase_passes 0 + + # + # Lookup the testcase definition. + # + set testcase_bodys {} + foreach testcase [nsv_get aa_test cases] { + if {$testcase_id == [lindex $testcase 0]} { + set testcase_file [lindex $testcase 2] + set package_key [lindex $testcase 3] + set aa_package_key $package_key + set testcase_cats [lindex $testcase 4] + set testcase_inits [lindex $testcase 5] + set testcase_on_error [lindex $testcase 6] + set testcase_bodys [lindex $testcase 7] + } + } + if {[llength $testcase_bodys] == 0} { + return + } + + + # + # Create any file-wide stubs. + # + if {[nsv_exists aa_file_wide_stubs "$testcase_file"]} { + foreach stub_def [nsv_get aa_file_wide_stubs "$testcase_file"] { + aa_stub [lindex $stub_def 0] [lindex $stub_def 1] + } + } + + # + # Run the test + # + set sql "delete from aa_test_results + where testcase_id = :testcase_id" + db_dml delete_testcase_results $sql + set sql "delete from aa_test_final_results + where testcase_id = :testcase_id" + db_dml delete_testcase_final_results $sql + + ns_log notice "Running testcase $testcase_id" + + set catch_val [catch _${package_key}__$testcase_id msg] + if {$catch_val} { + aa_log_result "fail" "$testcase_id: Error calling testcase function _${package_key}__$testcase_id: $msg" + } + + # + # Unstub any stubbed functions + # + foreach stub_name $aa_stub_names { + aa_unstub $stub_name + } + set aa_stub_names {} + + aa_log_final $aa_testcase_passes $aa_testcase_fails + unset aa_testcase_id +} + + +ad_proc -public aa_equals { + affirm_name + affirm_actual + affirm_value +} { + Tests that the affirm_actual is equal to affirm_value.
+ Call this function within a testcase, stub or component. + @author Peter Harper + @creation-date 24 July 2001 +} { + global aa_testcase_id + global aa_package_key + + if {$affirm_actual != $affirm_value} { + aa_log_result "fail" \ + "$affirm_name \ + Affirm FAILED, actual = \"$affirm_actual\", expected = \"$affirm_value\"" + } else { + aa_log_result "pass" \ + "$affirm_name \ + Affirm PASSED, actual = \"$affirm_actual\"" + } +} + +ad_proc -public aa_true { + affirm_name + affirm_expr +} { + Tests that affirm_expr is true.
+ Call this function within a testcase, stub or component.
+ @author Peter Harper
+ @creation-date 24 July 2001
+} {
+ global aa_testcase_id
+ global aa_package_key
+
+ set result [uplevel 1 [list expr $affirm_expr]]
+ if {$result} {
+ aa_log_result "pass" \
+ "$affirm_name \
+ Affirm PASSED, \"$affirm_expr\" true"
+ } else {
+ aa_log_result "fail" \
+ "$affirm_name \
+ Affirm FAILED, \"$affirm_expr\" false"
+ }
+}
+
+ad_proc -public aa_false {
+ affirm_name
+ affirm_expr
+} {
+ Tests that affirm_expr is false.
+ Call this function within a testcase, stub or component.
+ @author Peter Harper
+ @creation-date 24 July 2001
+} {
+ global aa_testcase_id
+ global aa_package_key
+
+ set result [uplevel 1 [list expr $affirm_expr]]
+ if {!$result} {
+ aa_log_result "pass" \
+ "$affirm_name \
+ Affirm PASSED, \"$affirm_expr\" false"
+ } else {
+ aa_log_result "fail" \
+ "$affirm_name \
+ Affirm FAILED, \"$affirm_expr\" true"
+ }
+}
+
+ad_proc -public aa_log {
+ log_notes
+} {
+ Writes a log message to the testcase log.
+ Call this function within a testcase, stub or component. + @author Peter Harper + @creation-date 24 July 2001 +} { + global aa_testcase_id + global aa_package_key + global aa_run_quietly_p + + if {$aa_run_quietly_p} { + return + } + + aa_log_result "log" $log_notes +} + +ad_proc -public aa_error { + error_notes +} { + Writes an error message to the testcase log.
+ Call this function within a testcase, stub or component. + @author Peter Harper + @creation-date 04 November 2001 +} { + aa_log_result "fail" $error_notes +} + +ad_proc aa_log_result { + test_result + test_notes +} { + @author Peter Harper + @creation-date 24 July 2001 +} { + global aa_testcase_id + global aa_testcase_test_id + global aa_testcase_fails + global aa_testcase_passes + global aa_package_key + global aa_in_init_class + global aa_init_class_logs + + # + # If logging is happened whilst in a initialisation class, store the log + # entry, but don't write it to the database. Individual testcase will make + # their own copies of these log entries. + # + if {$aa_in_init_class != ""} { + lappend aa_init_class_logs($aa_in_init_class) \ + [list $test_result $test_notes] + return + } + + incr aa_testcase_test_id + if {$test_result == "pass"} { + ns_log Notice "PASSED: $aa_testcase_id, $test_notes" + incr aa_testcase_passes + } elseif {$test_result == "fail"} { + ns_log Error "FAILED: $aa_testcase_id, $test_notes" + incr aa_testcase_fails + } else { + ns_log Notice "LOG: $aa_testcase_id, $test_notes" + set test_result "log" + } + db_dml test_result_insert { + insert into aa_test_results + (testcase_id, package_key, test_id, timestamp, result, notes) + values (:aa_testcase_id, :aa_package_key, :aa_testcase_test_id, + sysdate, :test_result, :test_notes) + } +} + +ad_proc aa_log_final { + test_passes + test_fails +} { + @author Peter Harper + @creation-date 24 July 2001 +} { + global aa_testcase_id + global aa_testcase_fails + global aa_testcase_passes + global aa_package_key + + if {$test_fails == 0} { + } else { + ns_log Notice "FAILED: $aa_testcase_id, $test_fails tests failed" + } + + db_dml testcase_result_insert { + insert into aa_test_final_results + (testcase_id, package_key, timestamp, passes, fails) + values (:aa_testcase_id, :aa_package_key, sysdate, :test_passes, :test_fails) + } +} + +# +# Set the valid testcase categories list, and testcase/component lists. +# +nsv_set aa_test cases {} +nsv_set aa_test components {} +nsv_set aa_test init_classes {} +nsv_set aa_test categories {config db script web} Index: openacs-4/packages/acs-automated-testing/tcl/example-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/example-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-automated-testing/tcl/example-procs.tcl 11 Nov 2001 18:03:52 -0000 1.1 @@ -0,0 +1,44 @@ +############################################################################## +# +# Copyright 2001, OpenACS, Peter Harper. +# +# This file is part of acs-automated-testing +# +############################################################################## + +ad_library { + Example procedures with which to demonstrate the acs-automated-testing + automated testing platform. + + @author Peter Harper (peter.harper@open-msg.com) + @creation-date 24 July 2001 + @cvs-id $Id: example-procs.tcl,v 1.1 2001/11/11 18:03:52 peterh Exp $ +} + +ad_proc aa_example_write_audit_entry { + name + value +} { + @author Peter Harper + @creation-date 24 July 2001 +} { + ns_log notice "Auditing: $name, $value" + return 1 +} + +ad_proc aa_example_write_audit_entries { + entries +} { + @author Peter Harper + @creation-date 24 July 2001 +} { + foreach entry $entries { + set name [lindex $entry 0] + set value [lindex $entry 1] + set result [aa_example_write_audit_entry $name $value] + if {$result == 0} { + return 0 + } + } + return 1; +} Index: openacs-4/packages/acs-automated-testing/tcl/example-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/Attic/example-test-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-automated-testing/tcl/example-test-procs.tcl 11 Nov 2001 18:03:52 -0000 1.1 @@ -0,0 +1,142 @@ +############################################################################## +# +# Copyright 2001, OpenMSG Ltd, Peter Harper. +# +# This file is part of acs-automated-testing. +# +############################################################################## + +aa_register_init_class "my_init" { + An example chunk of initialisation code. +} { + # Constructor + aa_export_vars {my_var1 my_var2} + + set my_var1 "Variable 1" + set my_var2 "Variable 2" + aa_equals "Do a dummy test on my_var1" $my_var1 "Variable 1" + aa_log "Do a test log message" +} { + # Descructor + # aa_log, aa_equals, aa_true and aa_false all ignored here. + set _my_var1 $my_var1 + set _my_var2 $my_var2 + aa_log "Do a log message that should be ignored" +} + + +aa_register_init_class "my_init2" { + An second example chunk of initialisation code. +} { + # Constructor + aa_log "The second constructor" +} { + # Descructor + aa_log "The second destructor" +} + + +aa_register_component "my_component" { + An example chunk of component code. +} { + aa_export_vars {an_example_value} + set an_example_value 1000 + aa_log "Log message from the example component my_component" +} + +aa_register_case -cats { + script +} -init_classes { + my_init +} "aa_example-000" { + Tests successful audit writing. +} { + aa_call_component "my_component" +} { + set test_value 1056 + + aa_stub aa_example_write_audit_entry { + switch $sequence_id { + 1 { + aa_equals "aa_example_write_audit_entry" $name "name1" + aa_equals "aa_example_write_audit_entry" $value "value1" + return 1 + } + 2 { + aa_equals "aa_example_write_audit_entry" $name "name2" + aa_equals "aa_example_write_audit_entry" $value "value2" + return 1 + } + } + } + + set entries {{"name1" "value1"} {"name2" "value2"}} + set entries_ex $entries + + set result [aa_example_write_audit_entries $entries] + + aa_log "This is a test log message" + aa_true "return value true" $result + aa_equals "entries parameter not currupted" $entries $entries_ex +} { + aa_equals "Check that test_value is visible here" $test_value "1056" + aa_equals "Check that my_component set value is visible here" $an_example_value "1000" +} + +aa_register_case -cats { + script +} -init_classes { + my_init my_init2 +} "aa-example-001" { + Tests un-successful audit writing. + First call succeeds, second fails +} { + aa_stub aa_example_write_audit_entry { + switch $sequence_id { + 1 { + aa_equals "aa_example_write_audit_entry, name" $name "name1" + aa_equals "aa_example_write_audit_entry, value" $value "value1" + return 1 + } + 2 { + aa_equals "aa_example_write_audit_entry, name" $name "name2" + aa_equals "aa_example_write_audit_entry, value" $value "value2" + return 0 + } + } + } + + set entries {{"name1" "value1"} {"name2" "value2"}} + set entries_ex $entries + + set result [aa_example_write_audit_entries $entries] + + aa_false "return value false" $result + aa_equals "entries parameter not currupted" $entries $entries_ex +} + +aa_register_case -cats { + script +} "aa_example-002" { + Tests un-successful audit writing. + First call fails. +} { + aa_stub aa_example_write_audit_entry { + switch $sequence_id { + 1 { + aa_equals "aa_example_write_audit_entry, name" $name "name1" + aa_equals "aa_example_write_audit_entry, value" $value "value1" + return 0 + } + } + } + + set entries {{"name1" "value1"} {"name2" "value2"}} + set entries_ex $entries + + set result [aa_example_write_audit_entries $entries] + + aa_false "return value false" $result + aa_equals "entries parameter not currupted" $entries $entries_ex +} + Index: openacs-4/packages/acs-automated-testing/tcl/filter-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/filter-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-automated-testing/tcl/filter-procs.tcl 11 Nov 2001 18:03:52 -0000 1.1 @@ -0,0 +1,24 @@ +ad_page_contract_filter aa_test_view_by { name value } { + Checks whether a view_by value has a value of "testcase", "package" or + "category" +} { + if {$value != "testcase" && + $value != "package"} { + ad_complain "Invalid view_by name" + return 0 + } + return 1 +} + +ad_page_contract_filter aa_test_category { name value } { + Checks whether a category value has is valid. +} { + set found 0 + foreach category [nsv_get aa_test categories] { + if {$value == $category} { + return 1 + } + } + ad_complain "$value is not a valid acs-automated-testing testcase category" + return 0 +} Index: openacs-4/packages/acs-automated-testing/www/index.html =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/Attic/index.html,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-automated-testing/www/index.html 11 Nov 2001 18:03:52 -0000 1.1 @@ -0,0 +1,12 @@ + +
+
+You probably want either the testcase admin pages .
+
+
Index: openacs-4/packages/acs-automated-testing/www/admin/clear.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/clear.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/www/admin/clear.tcl 11 Nov 2001 18:03:52 -0000 1.1
@@ -0,0 +1,19 @@
+ad_page_contract {
+ @cvs_id
+} {
+ {package_key ""}
+ {category:aa_test_category ""}
+ {view_by:aa_test_view_by "package"}
+ {testcase_id:nohtml ""}
+ {quiet "0"}
+} -properties {
+}
+
+set sql "delete from aa_test_results"
+db_dml delete_testcase_tests_sql $sql
+set sql "delete from aa_test_final_results"
+db_dml delete_testcase_tests_sql $sql
+
+ad_returnredirect "index"
+
+ad_returnredirect "index?by_package_key=$package_key&by_category=$category&view_by=$view_by&quiet=$quiet"
Index: openacs-4/packages/acs-automated-testing/www/admin/component.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/component.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/www/admin/component.adp 11 Nov 2001 18:03:52 -0000 1.1
@@ -0,0 +1,19 @@
+
+
+
+
+
+Results
+
+
+
Index: openacs-4/packages/acs-automated-testing/www/admin/component.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/component.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/www/admin/component.tcl 11 Nov 2001 18:03:52 -0000 1.1
@@ -0,0 +1,27 @@
+ad_page_contract {
+ @cvs_id
+} {
+ component_id:nohtml
+ package_key:nohtml
+} -properties {
+ title:onevalue
+ context_bar:onevalue
+ component_desc:onevalue
+ component_file:onevalue
+ component_body:onevalue
+}
+
+set title "Component $component_id ($package_key)"
+set context_bar [list $title]
+
+set component_bodys {}
+foreach component [nsv_get aa_test components] {
+ if {$component_id == [lindex $component 0] &&
+ $package_key == [lindex $component 1]} {
+ set component_desc [lindex $component 2]
+ set component_file [lindex $component 3]
+ set component_body [lindex $component 4]
+ }
+}
+
+ad_return_template
Index: openacs-4/packages/acs-automated-testing/www/admin/index-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/index-oracle.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/www/admin/index-oracle.xql 11 Nov 2001 18:03:52 -0000 1.1
@@ -0,0 +1,14 @@
+
+
+ @title@
+
+
+
+ @component_body@
+
+
+
+
+ Category
+ Mode
+ View by
+
+
+ [
+
+ [
+
+ [
+
+
+
+
+
+ Package key
+ Total run testcases
+ Passes
+ Fails
+ Result
+
+
+ @packageinfo.key@
+ No Data - -
+
+ fail
+
+ @packageinfo.total@
+ @packageinfo.passes@
+ @packageinfo.fails@
+
+
+
+
+
+
+ Package key
+ Testcase id
+ Categories
+ Description
+ Timestamp
+ Passes
+ Fails
+ Result
+ @tests.package_key@
+
+ @tests.package_key@
+ @tests.id@
+ @tests.categories@
+ @tests.description@
+ No Data - -
+
+ fail
+
+ @tests.timestamp@
+ @tests.passes@
+ @tests.fails@
+
+
+ @title@
+<%= [eval ad_context_bar $context_bar] %>
+
+
+<%= [ad_footer] %>
Index: openacs-4/packages/acs-automated-testing/www/admin/rerun.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/rerun.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/www/admin/rerun.tcl 11 Nov 2001 18:03:52 -0000 1.1
@@ -0,0 +1,27 @@
+ad_page_contract {
+ @cvs_id
+} {
+ {package_key ""}
+ {category:aa_test_category ""}
+ {view_by:aa_test_view_by "package"}
+ {testcase_id:nohtml ""}
+ {quiet "0"}
+} -properties {
+}
+
+if {$testcase_id == ""} {
+ if {$quiet} {
+ aa_runseries -quiet $package_key $category
+ } else {
+ aa_runseries $package_key $category
+ }
+ ad_returnredirect "index?by_package_key=$package_key&by_category=$category&view_by=$view_by&quiet=$quiet"
+} else {
+ if {$quiet} {
+ aa_runseries -quiet -testcase_id $testcase_id "" ""
+ } else {
+ aa_runseries -testcase_id $testcase_id "" ""
+ }
+ ad_returnredirect "testcase?testcase_id=$testcase_id&package_key=$package_key&quiet=$quiet"
+}
+
Index: openacs-4/packages/acs-automated-testing/www/admin/testcase-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/testcase-oracle.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/www/admin/testcase-oracle.xql 11 Nov 2001 18:03:52 -0000 1.1
@@ -0,0 +1,24 @@
+
+
+
+ Testcase @testcase_id@ (@package_key@)
+
+
+
+ @bodys.body@
+
+
+
+
+
Index: openacs-4/packages/acs-automated-testing/www/admin/testcase.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/testcase.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-automated-testing/www/admin/testcase.tcl 11 Nov 2001 18:03:52 -0000 1.1
@@ -0,0 +1,79 @@
+ad_page_contract {
+ @cvs_id
+} {
+ testcase_id:nohtml
+ package_key:nohtml
+ {showsource 0}
+ {quiet 0}
+} -properties {
+ title:onevalue
+ context_bar:onevalue
+ tests:multirow
+ showsource:onevalue
+ testcase_desc:onevalue
+ testcase_file:onevalue
+ testcase_on_error:onevalue
+ bodys:multirow
+ quiet:onevalue
+ fails:onevalue
+}
+set title "Test case $testcase_id"
+set context_bar [list $title]
+
+db_multirow tests acs-automated-testing.testcase_query {
+ select to_char(timestamp,'DD-MM-YYYY HH24:MI:SS') timestamp, result, notes
+ from aa_test_results
+ where testcase_id = :testcase_id and
+ package_key = :package_key
+ order by test_id
+}
+
+if {![db_0or1row acs-automated-testing.get_testcase_fails_count {
+ select fails
+ from aa_test_final_results
+ where testcase_id = :testcase_id
+}]} {
+ set fails -1
+}
+
+set testcase_bodys {}
+foreach testcase [nsv_get aa_test cases] {
+ if {$testcase_id == [lindex $testcase 0] &&
+ $package_key == [lindex $testcase 3]} {
+ set testcase_desc [lindex $testcase 1]
+ set testcase_file [lindex $testcase 2]
+ set package_key [lindex $testcase 3]
+ set testcase_cats [string map {" " ", "} [lindex $testcase 4]]
+ set testcase_inits [string map {" " ", "} [lindex $testcase 5]]
+ set testcase_on_error [lindex $testcase 6]
+ set testcase_bodys [lindex $testcase 7]
+ }
+}
+
+template::multirow create bodys body_number body
+if {[llength $testcase_bodys] == 0} {
+ set testcase_desc ""
+ set testcase_file ""
+} else {
+ set body_count 0
+
+ #
+ # Work out the URL for this directory (stripping off the file element).
+ #
+ set url "[ad_conn url]"
+ regexp {(.*)/[^/]*} $url {\\1} url
+ append url "/component?package_key=${package_key}"
+
+ foreach body $testcase_bodys {
+ #
+ # This regsub changes any "aa_call_component Time
+ Result
+ Notes
+ No results
+
+
+ @tests.timestamp@
+
+
+ @tests.notes@
+
+