OpenACS

antoniop
committed
oacs-5-10:antoniop:20230420132459
on 20 Apr 23
Test optional external command dependencies
openacs-4/.../acs-automated-testing/tcl/aa-test-procs.tcl (+14 -1)
122 122       global aa_testcase_id
123 123       set sequence_id \$::aa_stub_sequence\($proc_name\)
124 124       incr ::aa_stub_sequence\($proc_name\)
125 125       $new_body
126 126     "
127 127         return
128 128     } else {
129 129         #
130 130         # File wide stub.
131 131         #
132 132         if {![nsv_exists aa_file_wide_stubs [info script]]} {
133 133             nsv_set aa_file_wide_stubs [info script] {}
134 134         }
135 135         nsv_lappend aa_file_wide_stubs [info script] [list $proc_name $new_body]
136 136     }
137 137 }
138 138
139 139 ad_proc -public aa_unstub {
140 140     proc_name
141 141 } {
  142     Copies (back) a proc with "_unstubbed" suffix to its supposedly
  143     unpostfixed original name.
  144
142 145     @author Peter Harper
143 146     @creation-date 24 July 2001
144 147 } {
145 148     aa_proc_copy ${proc_name}_unstubbed $proc_name
146 149     return
147 150 }
148 151
149 152 ad_proc -public aa_register_init_class {
150 153     init_class_id
151 154     init_class_desc
152 155     constructor
153 156     destructor
154 157 } {
155 158     Registers an initialization class to be used by one or more testcases.  An
156 159     initialization class can be assigned to a testcase via the
157 160     aa_register_case proc.
158 161
159 162     An initialization constructor is called <strong>once</strong> before
160 163     running a set of testcases, and the destructor called <strong>once</strong>
161 164     upon completion of running a set of testcases.<p>
 
872 875         #
873 876         ns_log notice "aa_log: $log_notes"
874 877     }
875 878 }
876 879
877 880 ad_proc -public aa_error {
878 881     error_notes
879 882 } {
880 883     Writes an error message to the testcase log.<p>
881 884     Call this function within a testcase, stub or component.
882 885     @author Peter Harper
883 886     @creation-date 04 November 2001
884 887 } {
885 888     aa_log_result "fail" $error_notes
886 889 }
887 890
888 891 ad_proc -public aa_log_result {
889 892     test_result
890 893     args
891 894 } {
  895     Log a test result
  896
892 897     @author Peter Harper
893 898     @creation-date 24 July 2001
894 899 } {
895 900     set test_notes [join $args ""]
896 901     if { [aa_in_rollback_block_p] } {
897 902         aa_add_rollback_test [list aa_log_result $test_result $test_notes]
898 903         return
899 904     }
900 905
901 906     #
902 907     # When aa_run_quietly_p exists, we run inside the testing
903 908     # environment. Otherwise, report and return.
904 909     #
905 910     if {![info exists ::aa_run_quietly_p]} {
906 911         ns_log warning "aa_log_result: called outside the testing environment." \
907 912             "Test result: $test_result Test notes: $test_notes"
908 913             return
909 914     }
910 915     #
911 916     # If logging is happened whilst in an initialization class, store the log
 
1635 1640     ad_proc -public ::acs::test::confirm_email {
1636 1641         -user_id:required
1637 1642     } {
1638 1643         Confirms user email
1639 1644     } {
1640 1645         # Call the confirmation URL and check response
1641 1646         set token [auth::get_user_secret_token -user_id $user_id]
1642 1647         set to_addr [party::get -party_id $user_id -element email]
1643 1648         set confirmation_url [export_vars -base "/register/email-confirm" { token user_id }]
1644 1649         set d [acs::test::http $confirmation_url]
1645 1650         acs::test::reply_has_status_code $d 200
1646 1651     }
1647 1652
1648 1653     ad_proc -public ::acs::test::visualize_control_chars {lines} {
1649 1654         Quotes and therefore makes visible control chars in input lines
1650 1655     } {
1651 1656         return [string map {\\ \\\\ \r \\r \n "\\n\n"} $lines]
1652 1657     }
1653 1658
1654 1659     ad_proc -public ::acs::test::dom_html {var html body} {
  1660         Parses HTML into a tDOM object and executes some code.
  1661
  1662         @param var the variable name that body can refer to as
  1663                    documentElement of the document (e.g. "root").
  1664         @param html the markup to be parsed.
  1665         @param body a tcl script executed in the caller scope that can
  1666                     assume the document to be pased and be available
  1667                     in "var".
1655 1668     } {
1656 1669         upvar $var root
1657 1670         try {
1658 1671             dom parse -html $html doc
1659 1672         } on error {errorMsg} {
1660 1673             ns_log error "Failed to parse the following HTML text with message: $errorMsg\n$html"
1661 1674         }
1662 1675         $doc documentElement root
1663 1676         uplevel 1 $body
1664 1677     }
1665 1678
1666 1679     ad_proc -public get_form {body xpath} {
1667 1680
1668 1681         Locate the HTML forms matching the XPath expression and
1669 1682         retrieve its HTML attributes and the formfields in form of a
1670 1683         Tcl dict. This is a convenience function, combining
1671 1684         acs::test::dom_html and ::acs::test::xpath::get_form.
1672 1685
1673 1686         @return Tcl dict with form attributes (starting with "@" and fields)
1674 1687         @see acs::test::dom_html ::acs::test::xpath::get_form