Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl,v diff -u -r1.50 -r1.51 --- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 4 Jul 2018 13:10:14 -0000 1.50 +++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 19 Jul 2018 11:43:18 -0000 1.51 @@ -101,7 +101,7 @@ array set parsed_callback_array $spec_array(callbacks) aa_true "Only one permissible callback should be returned, got array [array get parsed_callback_array]" \ - [expr {[array size parsed_callback_array] == 1}] + {[array size parsed_callback_array] == 1} aa_equals "Checking name of callback of allowed type $allowed_type" \ $parsed_callback_array($allowed_type) $callback_array($allowed_type) @@ -282,11 +282,11 @@ [site_node::get_children -all -element node_id -node_id $node_id -package_type "apm_service"] \ $nodes - aa_true "Found at least one apm_service node" [expr {[llength $nodes] > 0}] + aa_true "Found at least one apm_service node" {[llength $nodes] > 0} # nonexistent package_type aa_true "No nodes with package type 'foo'" \ - [expr {[llength [site_node::get_children -all -element node_id -node_id $node_id -package_type "foo"]] == 0}] + {[llength [site_node::get_children -all -element node_id -node_id $node_id -package_type "foo"]] == 0} } Index: openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl,v diff -u -r1.11 -r1.12 --- openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl 7 Aug 2017 23:48:00 -0000 1.11 +++ openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl 19 Jul 2018 11:43:19 -0000 1.12 @@ -25,12 +25,12 @@ ad_proc -callback a_callback { -arg1 arg2 } { this is a test callback } - set callback_procs [info commands ::callback::a_callback::*] aa_true "creation of a valid callback contract with '-' body" \ - [expr {"::callback::a_callback::contract" in $callback_procs}] + {"::callback::a_callback::contract" in $callback_procs} ad_proc -callback a_callback_2 { arg1 arg2 } { this is a test callback } {} set callback_procs [info commands ::callback::a_callback_2::*] aa_true "creation of a valid callback contract with no body" \ - [expr {"::callback::a_callback_2::contract" in $callback_procs}] + {"::callback::a_callback_2::contract" in $callback_procs} aa_true "throw error for missing -callback on implementation definition" \ [catch { @@ -48,7 +48,7 @@ } set impl_procs [info commands ::callback::a_callback::impl::*] aa_true "creation of a valid callback implementation" \ - [expr {"::callback::a_callback::impl::an_impl" in $impl_procs}] + {"::callback::a_callback::impl::an_impl" in $impl_procs} } ad_proc -callback a_callback { @@ -106,18 +106,18 @@ [catch {callback c_callback bar} error] aa_true "callback returns empty list with no implementations" \ - [expr {[llength [callback b_callback -arg1 foo bar]] == 0}] + {[llength [callback b_callback -arg1 foo bar]] == 0} set foo(test) 2 aa_true "callback returns value for each defined callback and catches the error callback" \ - [expr {[llength [callback -catch a_callback -arg1 foo bar]] == 2}] + {[llength [callback -catch a_callback -arg1 foo bar]] == 2} aa_true "callback returns correct value for specified implementation" \ - [expr {[callback -impl an_impl1 a_callback -arg1 foo bar] == 1}] + {[callback -impl an_impl1 a_callback -arg1 foo bar] == 1} aa_true "callback returns correct value for an array ref" \ - [expr {[callback -impl an_impl2 a_callback -arg1 foo bar] == 2}] + {[callback -impl an_impl2 a_callback -arg1 foo bar] == 2} aa_true "callback works with {} args" \ [expr {[callback -impl an_impl2 a_callback -arg1 {} {}] == {}}] Index: openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl,v diff -u -r1.6 -r1.7 --- openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl 7 Aug 2017 23:48:00 -0000 1.6 +++ openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl 19 Jul 2018 11:43:19 -0000 1.7 @@ -20,7 +20,7 @@ set correct_links [list 0] aa_log "Links = '${links}'" aa_true "Number of links found is correct" \ - [expr {[llength $correct_links] eq [llength $links]}] + {[llength $correct_links] eq [llength $links]} } @@ -62,7 +62,7 @@ [application_data_link::get_links_from \ -object_id $o($n)]] aa_true "Object \#${n} references correct" \ - [expr {$correct_links eq $links}] + {$correct_links eq $links} } # now change the text and update one of the objects for {set i 0} {$i < 5} {incr i} { @@ -82,7 +82,7 @@ [application_data_link::get_links_from \ -object_id $o($i)]] aa_true "Object \#${i} updated references correct" \ - [expr {$new_correct_links eq $links}] + {$new_correct_links eq $links} } } } @@ -105,7 +105,7 @@ set correct_links [list 0] aa_log "Links = '${links}'" aa_true "Number of links found is correct" \ - [expr {[llength $correct_links] eq [llength $links]}] + {[llength $correct_links] eq [llength $links]} } @@ -149,7 +149,7 @@ [application_data_link::get_links_from \ -object_id $o($n) -relation_tag tag]] aa_true "Object \#${n} references correct" \ - [expr {$correct_links eq $links}] + {$correct_links eq $links} } # now change the text and update one of the objects for {set i 0} {$i < 5} {incr i} { @@ -171,7 +171,7 @@ -object_id $o($i) \ -relation_tag tag]] aa_true "Object \#${i} updated references correct" \ - [expr {$new_correct_links eq $links}] + {$new_correct_links eq $links} } } } @@ -219,22 +219,22 @@ application_data_link::new -this_object_id $o(3) -target_object_id $o(5) -relation_tag tag2 aa_true "Verify link for tag1" \ - [expr {[llength [application_data_link::get_linked -from_object_id $o(0) \ - -to_object_type [acs_object_type $o(0)] -relation_tag tag1]] == 2}] + {[llength [application_data_link::get_linked -from_object_id $o(0) \ + -to_object_type [acs_object_type $o(0)] -relation_tag tag1]] == 2} aa_true "Verify link for tag2" \ - [expr {[llength [application_data_link::get_linked -from_object_id $o(3) \ - -to_object_type [acs_object_type $o(3)] -relation_tag tag2]] == 3}] + {[llength [application_data_link::get_linked -from_object_id $o(3) \ + -to_object_type [acs_object_type $o(3)] -relation_tag tag2]] == 3} aa_true "Verify content link" \ - [expr {[llength [application_data_link::get_linked_content -from_object_id $o(0) \ - -to_content_type content_revision -relation_tag tag1]] == 2}] + {[llength [application_data_link::get_linked_content -from_object_id $o(0) \ + -to_content_type content_revision -relation_tag tag1]] == 2} aa_true "Verify links to one object with multiple link tags" \ - [expr {[llength [application_data_link::get -object_id $o(0) -relation_tag tag1]] == 2}] + {[llength [application_data_link::get -object_id $o(0) -relation_tag tag1]] == 2} aa_true "Verify links to one object with multiple link tags" \ - [expr {[llength [application_data_link::get -object_id $o(0) -relation_tag tag2]] == 1}] + {[llength [application_data_link::get -object_id $o(0) -relation_tag tag2]] == 1} } } Index: openacs-4/packages/acs-tcl/tcl/test/doc-check-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/doc-check-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-tcl/tcl/test/doc-check-procs.tcl 7 Aug 2017 23:48:00 -0000 1.3 +++ openacs-4/packages/acs-tcl/tcl/test/doc-check-procs.tcl 19 Jul 2018 11:43:19 -0000 1.4 @@ -15,7 +15,8 @@ set good 0 foreach p [lsort -dictionary [nsv_array names api_proc_doc]] { array set pa [nsv_get api_proc_doc $p] - if { "public" in $pa(protection) + if { [info exists pa(protection)] + && "public" in $pa(protection) && !($pa(deprecated_p) || $pa(warn_p)) } { incr count @@ -41,7 +42,9 @@ set good 0 foreach p [lsort -dictionary [nsv_array names api_proc_doc]] { array set pa [nsv_get api_proc_doc $p] - if { $pa(deprecated_p)||$pa(warn_p) } { + if { ([info exists pa(deprecated_p)] && $pa(deprecated_p)) + || ([info exists pa(warn_p)] && $pa(warn_p)) + } { incr count if { ![info exists pa(see)] || [string is space $pa(see)] } { aa_log_result fail "No @see for deprecated proc $p" Index: openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl 27 Mar 2018 12:22:17 -0000 1.4 +++ openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl 19 Jul 2018 11:43:19 -0000 1.5 @@ -33,52 +33,52 @@ permission::grant -party_id $user_id -object_id $new_package_id -privilege "admin" # Verifying the admin privilege on the user aa_true "testing admin privilege" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] == 1}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] == 1} # Revoking admin privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "admin" aa_true "testing if admin privilege was revoked" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] == 0}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] == 0} # Grant read privilege permission::grant -party_id $user_id -object_id $new_package_id -privilege "read" # Verifying the read privilege on the user aa_true "testing read permissions" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "read" ] == 1}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "read" ] == 1} # Revoking read privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "read" # We tested with a query because we have problems with inherit aa_true "testing if read privilege was revoked" \ - [expr {[db_string test_read "select 1 from acs_permissions where object_id = :new_package_id and grantee_id = :user_id" -default 0] == 0}] + {[db_string test_read "select 1 from acs_permissions where object_id = :new_package_id and grantee_id = :user_id" -default 0] == 0} # Grant write privilege permission::grant -party_id $user_id -object_id $new_package_id -privilege "write" # Verifying the write privilege on the user aa_true "testing write permissions" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 1}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 1} # Revoking write privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "write" aa_true "testing if write permissions was revoked" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 0}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 0} # Grant create privilege permission::grant -party_id $user_id -object_id $new_package_id -privilege "create" # Verifying the create privilege on the user aa_true "testing create permissions" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 1}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 1} # Revoking create privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "create" aa_true "testing if create privileges was revoked" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 0}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 0} # Grant delete privilege permission::grant -party_id $user_id -object_id $new_package_id -privilege "delete" # Verifying the delete privilege on the user aa_true "testing delete permissions" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 1}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 1} # Revoking delete privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "delete" aa_true "testing if delete permissions was revoked" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 0}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 0} } } @@ -101,27 +101,27 @@ #Grant permissions for this user in this object permission::grant -party_id $user_id -object_id $new_package_id -privilege "delete" aa_true "testing admin permissions" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 1}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 1} permission::revoke -party_id $user_id -object_id $new_package_id -privilege "delete" permission::grant -party_id $user_id -object_id $new_package_id -privilege "create" aa_true "testing create permissions" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 1}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 1} permission::revoke -party_id $user_id -object_id $new_package_id -privilege "create" permission::grant -party_id $user_id -object_id $new_package_id -privilege "write" aa_true "testing write permissions" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 1}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 1} permission::revoke -party_id $user_id -object_id $new_package_id -privilege "write" permission::grant -party_id $user_id -object_id $new_package_id -privilege "read" aa_true "testing read permissions" \ - [expr {[db_string test_read "select 1 from acs_permissions where object_id = :new_package_id and grantee_id = :user_id" -default 0] == 1}] + {[db_string test_read "select 1 from acs_permissions where object_id = :new_package_id and grantee_id = :user_id" -default 0] == 1} permission::revoke -party_id $user_id -object_id $new_package_id -privilege "read" permission::grant -party_id $user_id -object_id $new_package_id -privilege "admin" aa_true "testing delete permissions" \ - [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin" ] == 1}] + {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin" ] == 1} permission::revoke -party_id $user_id -object_id $new_package_id -privilege "admin" } } Index: openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl,v diff -u -r1.7 -r1.8 --- openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl 7 Aug 2017 23:48:00 -0000 1.7 +++ openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl 19 Jul 2018 11:43:19 -0000 1.8 @@ -33,7 +33,7 @@ twt::user::login $user_info(email) $user_info(password) set logged_users [whos_online::num_users] - aa_true "New user logged - Users logged: $logged_users" [expr { $logged_users > 0 } ] + aa_true "New user logged - Users logged: $logged_users" { $logged_users > 0 } #--------------------------------------------------------------------------------------------------- #Test set_invisible @@ -43,14 +43,14 @@ whos_online::set_invisible $user_id - aa_true "User $user_info(email) is Invisible" [expr {[nsv_exists invisible_users $user_id] == 1 }] + aa_true "User $user_info(email) is Invisible" {[nsv_exists invisible_users $user_id] == 1 } #--------------------------------------------------------------------------------------------------- #Test all-invisible_user_ids #--------------------------------------------------------------------------------------------------- aa_true "User $user_info(email) with user_id=$user_id is in the invisible list" \ - [expr {$user_id in [whos_online::all_invisible_user_ids]}] + {$user_id in [whos_online::all_invisible_user_ids]} #--------------------------------------------------------------------------------------------------- #Test unset_invisible @@ -61,14 +61,14 @@ whos_online::unset_invisible $user_id aa_false "User $user_info(email) is Visible" \ - [expr {[whos_online::user_invisible_p $user_id ] == 1 }] + {[whos_online::user_invisible_p $user_id ] == 1 } #--------------------------------------------------------------------------------------------------- #Test user_ids #--------------------------------------------------------------------------------------------------- aa_true "User $user_info(email) with user_id=$user_id is in the visible list" \ - [expr {$user_id in [whos_online::user_ids]}] + {$user_id in [whos_online::user_ids]} twt::user::logout twt::user::delete -user_id $user_id