Some More Random Text /o/10 /file/11 /image/12
- /o/[junk] /file/[junk] /image/[junk]
+ /o/[junk] /file/[junk] /image/[junk]
/o/" /file/" /image/"
/o/[ /file/[ /image/[
-
- }
+
+ } ;#"]
append text " "
aa_log "ad_url = '[ad_url]'"
set links [application_data_link::scan_for_links -text $text]
set correct_links [list 0]
aa_log "Links = '${links}'"
- aa_true "Number of links found is correct" \
- {[llength $correct_links] eq [llength $links]}
-
+ aa_true "Number of links found is correct" {[llength $correct_links] eq [llength $links]}
}
-aa_register_case -cats api data_links_update_links {
- Test updating references,
- tests scan_for_links
- and delete_links in the process
+aa_register_case \
+ -cats api \
+ -procs {
+ application_data_link::scan_for_links
+ application_data_link::update_links_from
+ application_data_link::get_links_from
+ content::item::new
+ } \
+ data_links_update_links {
+
+ Test updating references, tests scan_for_links and delete_links in
+ the process.
+
} {
- aa_run_with_teardown \
- -rollback \
- -test_code \
- {
- # create some test objects
- set name [ns_mktemp "cr_item__XXXXXX"]
-
- for {set i 0} {$i<10} {incr i} {
- set o($i) [content::item::new \
- -name ${name}_$i \
- -title ${name}_$i]
- }
-
- # generate some text with links between the objects
- foreach n [array names o] {
- append text "\nTest Content Link to $o($n) Link \n"
- }
- # update the links
- foreach n [array names o] {
- application_data_link::update_links_from \
- -object_id $o($n) \
- -text $text
- }
- # scan for links and compare
- set correct_links [lsort \
- [application_data_link::scan_for_links \
- -text $text]]
- aa_true "Correct links is not empty" [llength $correct_links]
- foreach n [array names o] {
- set links [lsort \
- [application_data_link::get_links_from \
- -object_id $o($n)]]
- aa_true "Object \#${n} references correct" \
- {$correct_links eq $links}
- }
- # now change the text and update one of the objects
- for {set i 0} {$i < 5} {incr i} {
- append new_text "\nTest Content Link to $o($i) /o/$o($i) \n"
- }
- for {set i 0} {$i < 5} {incr i} {
- application_data_link::update_links_from \
- -object_id $o($i) \
- -text $new_text
- }
- set new_correct_links [lsort \
- [application_data_link::scan_for_links \
- -text $new_text]]
+ aa_run_with_teardown -rollback -test_code {
+ # create some test objects
+ set name [ns_mktemp "cr_item__XXXXXX"]
- for {set i 0} {$i < 5} {incr i} {
- set links [lsort \
- [application_data_link::get_links_from \
- -object_id $o($i)]]
- aa_true "Object \#${i} updated references correct" \
- {$new_correct_links eq $links}
- }
- }
+ for {set i 0} {$i<10} {incr i} {
+ set o($i) [content::item::new \
+ -name ${name}_$i \
+ -title ${name}_$i]
+ }
+
+ # generate some text with links between the objects
+ foreach n [array names o] {
+ append text "\nTest Content Link to $o($n) Link \n"
+ }
+ # update the links
+ foreach n [array names o] {
+ application_data_link::update_links_from \
+ -object_id $o($n) \
+ -text $text
+ }
+ # scan for links and compare
+ set correct_links [lsort [application_data_link::scan_for_links \
+ -text $text]]
+ aa_true "Correct links is not empty" [llength $correct_links]
+ foreach n [array names o] {
+ set links [lsort [application_data_link::get_links_from \
+ -object_id $o($n)]]
+ aa_true "Object \#${n} references correct" \
+ {$correct_links eq $links}
+ }
+ # now change the text and update one of the objects
+ for {set i 0} {$i < 5} {incr i} {
+ append new_text "\nTest Content Link to $o($i) /o/$o($i) \n"
+ }
+ for {set i 0} {$i < 5} {incr i} {
+ application_data_link::update_links_from \
+ -object_id $o($i) \
+ -text $new_text
+ }
+ set new_correct_links [lsort [application_data_link::scan_for_links \
+ -text $new_text]]
+
+ for {set i 0} {$i < 5} {incr i} {
+ set links [lsort [application_data_link::get_links_from \
+ -object_id $o($i)]]
+ aa_true "Object \#${i} updated references correct" \
+ {$new_correct_links eq $links}
+ }
+ }
}
-aa_register_case -cats api data_links_scan_links_with_tag {
- Test scanning content for object URLs with relation tag
+aa_register_case \
+ -cats api \
+ -procs {
+ application_data_link::scan_for_links
+ } \
+ data_links_scan_links_with_tag {
+
+ Test scanning content for object URLs with relation tag.
+
} {
# get a new object_id from the sequence, this object will not exist
set nonexistent_object_id [db_nextval "acs_object_id_seq"]
@@ -97,8 +107,8 @@
/o/[junk] /file/[junk] /image/[junk]
/o/" /file/" /image/"
/o/[ /file/[ /image/[
-
- }
+
+ } ;#"]
append text " "
aa_log "ad_url = '[ad_url]'"
set links [application_data_link::scan_for_links -text $text]
@@ -109,25 +119,30 @@
}
-aa_register_case -cats api data_links_update_links_with_tag {
- Test updating references,
- tests scan_for_links
- and delete_links in the process.
- Uses relation tags
+aa_register_case \
+ -cats api \
+ -procs {
+ application_data_link::get_links_from
+ application_data_link::scan_for_links
+ application_data_link::update_links_from
+ content::item::new
+ } \
+ data_links_update_links_with_tag {
+
+ Test updating references, tests scan_for_links and
+ delete_links in the process. Uses relation tags.
+
} {
- aa_run_with_teardown \
- -rollback \
- -test_code \
- {
+ aa_run_with_teardown -rollback -test_code {
# create some test objects
set name [ns_mktemp "cr_item__XXXXXX"]
-
+
for {set i 0} {$i<10} {incr i} {
set o($i) [content::item::new \
-name ${name}_$i \
-title ${name}_$i]
}
-
+
# generate some text with links between the objects
foreach n [array names o] {
append text "\nTest Content Link to $o($n) Link \n"
@@ -177,16 +192,28 @@
}
-aa_register_case -cats api data_links_with_tag {
- Test creating new link, exists test, get, get_linked and delete. Uses relation tags.
+aa_register_case \
+ -cats api \
+ -procs {
+ acs_object_type
+ application_data_link::delete_links
+ application_data_link::get
+ application_data_link::get_linked
+ application_data_link::get_linked_content
+ application_data_link::link_exists
+ application_data_link::new
+ content::item::new
+ } \
+ data_links_with_tag {
+
+ Test creating new link, exists test, get, get_linked and
+ delete. Uses relation tags.
+
} {
- aa_run_with_teardown \
- -rollback \
- -test_code \
- {
+ aa_run_with_teardown -rollback -test_code {
# create some test objects
set name [ns_mktemp "cr_item__XXXXXX"]
-
+
for {set i 0} {$i<6} {incr i} {
set o($i) [content::item::new \
-name ${name}_$i \
@@ -195,49 +222,50 @@
aa_log "Creating link between objects"
application_data_link::new -this_object_id $o(0) -target_object_id $o(1) -relation_tag tag
-
+
aa_true "Verify objects are linked" \
- [application_data_link::link_exists \
- -from_object_id $o(0) \
- -to_object_id $o(1) \
- -relation_tag tag]
-
+ [application_data_link::link_exists \
+ -from_object_id $o(0) \
+ -to_object_id $o(1) \
+ -relation_tag tag]
+
aa_log "Deleting links attached to first object"
application_data_link::delete_links -object_id $o(0)
-
+
aa_false "Verify objects are deleted" \
- [application_data_link::link_exists \
- -from_object_id $o(0) \
- -to_object_id $o(1) \
- -relation_tag tag]
-
+ [application_data_link::link_exists \
+ -from_object_id $o(0) \
+ -to_object_id $o(1) \
+ -relation_tag tag]
+
aa_log "Creating many links between objects"
application_data_link::new -this_object_id $o(0) -target_object_id $o(1) -relation_tag tag1
application_data_link::new -this_object_id $o(0) -target_object_id $o(2) -relation_tag tag1
application_data_link::new -this_object_id $o(0) -target_object_id $o(3) -relation_tag tag2
application_data_link::new -this_object_id $o(3) -target_object_id $o(4) -relation_tag tag2
application_data_link::new -this_object_id $o(3) -target_object_id $o(5) -relation_tag tag2
-
+
aa_true "Verify link for tag1" \
- {[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" \
- {[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" \
- {[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" \
- {[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" \
- {[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}
}
}
+
# Local variables:
# mode: tcl
# tcl-indent-level: 4
Index: openacs-4/packages/acs-tcl/tcl/test/community-core-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/community-core-test-procs.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-tcl/tcl/test/community-core-test-procs.tcl 25 Jul 2018 03:10:58 -0000 1.7
+++ openacs-4/packages/acs-tcl/tcl/test/community-core-test-procs.tcl 25 Jul 2018 13:42:48 -0000 1.8
@@ -3,13 +3,15 @@
@author byron Haroldo Linares Roman (bhlr@galileo.edu)
@creation-date 2006-07-28
- @arch-tag: 0D0EAC28-2481-4BEE-9645-A143B939DBCA
@cvs-id $Id$
}
aa_register_case \
-cats {api smoke} \
- -procs {cc_lookup_email_user cc_email_from_party} \
+ -procs {
+ party::email
+ party::get_by_email
+ } \
community_cc_procs \
{
test community core procs returned values
@@ -32,10 +34,20 @@
}
aa_register_case \
-cats {api smoke} \
- -procs {person::person_p person::get person::new person::update person::get_bio person::update_bio} \
+ -procs {
+ party::email
+ person::delete
+ person::get
+ person::get_bio
+ person::name
+ person::new
+ person::person_p
+ person::update
+ person::update_bio
+ } \
person_procs_test \
{
- test if the values returned by the person procs are correct
+ Test whether the values returned by the person procs are correct.
} {
set user_id [db_nextval acs_object_id_seq]
@@ -96,7 +108,10 @@
aa_register_case \
-cats {api smoke} \
- -procs {party::get_by_email party::update} \
+ -procs {
+ party::get_by_email
+ party::update
+ } \
party_procs_test \
{
test if the values returned by the party procs are correct
@@ -110,8 +125,13 @@
set last_name [ad_generate_random_string]
set url "url[ad_generate_random_string]"
- array set user_info [auth::create_user -user_id $user_id -username $username -email $email -first_names $first_names \
- -last_name $last_name -password $password \
+ array set user_info [auth::create_user \
+ -user_id $user_id \
+ -username $username \
+ -email $email \
+ -first_names $first_names \
+ -last_name $last_name \
+ -password $password \
-secret_question [ad_generate_random_string] \
-secret_answer [ad_generate_random_string]]
Index: openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl,v
diff -u -r1.18 -r1.19
--- openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl 19 Jul 2018 11:17:53 -0000 1.18
+++ openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl 25 Jul 2018 13:42:48 -0000 1.19
@@ -7,10 +7,16 @@
}
-aa_register_case -cats {db smoke production_safe} -error_level warning datamodel__named_constraints {
- Check that all the constraints meet the constraint naming standards.
+aa_register_case \
+ -cats {db smoke production_safe} \
+ -error_level warning \
+ -procs {} \
+ datamodel__named_constraints {
+
+ Check that all the constraints meet the constraint naming
+ standards.
- @author Jeff Davis davis@xarg.net
+ @author Jeff Davis davis@xarg.net
} {
set db_is_pg_p [string equal [db_name] "PostgreSQL"]
@@ -94,11 +100,15 @@
-aa_register_case -cats {db smoke production_safe} datamodel__acs_object_type_check {
- Check that the object type tables exist and that the id column is present and the
- name method works.
+aa_register_case \
+ -cats {db smoke production_safe} \
+ -procs {db_table_exists} \
+ datamodel__acs_object_type_check {
+
+ Check that the object type tables exist and that the id column is
+ present and the name method works.
- @author Jeff Davis davis@xarg.net
+ @author Jeff Davis davis@xarg.net
} {
db_foreach object_type {select * from acs_object_types} {
if {[string tolower $table_name] ne $table_name } {
@@ -152,11 +162,15 @@
-aa_register_case -cats {db smoke production_safe} datamodel__acs_attribute_check {
- Check that the acs_attribute column is present and the datatype is vaguely
- consistent with the db datatype.
+aa_register_case \
+ -cats {db smoke production_safe} \
+ -procs {db_column_type db_columns} \
+ datamodel__acs_attribute_check {
+
+ Check that the acs_attribute column is present and the
+ datatype is vaguely consistent with the db datatype.
- @author Jeff Davis davis@xarg.net
+ @author Jeff Davis davis@xarg.net
} {
array set allow_types {
string {TEXT VARCHAR CHAR VARCHAR2}
@@ -173,7 +187,11 @@
keyword {CHAR VARCHAR TEXT VARCHAR2}
}
- db_foreach attribute {select a.*, lower(ot.table_name) as obj_type_table from acs_attributes a, acs_object_types ot where ot.object_type = a.object_type order by a.object_type} {
+ db_foreach attribute {
+ select a.*, lower(ot.table_name) as obj_type_table
+ from acs_attributes a, acs_object_types ot
+ where ot.object_type = a.object_type order by a.object_type
+ } {
if {[string tolower $table_name] ne $table_name } {
aa_log_result fail "Type $object_type attribute $table_name.$attribute_name mixed case"
@@ -193,7 +211,7 @@
}
set column_name [string tolower $column_name]
- if {[lsearch $columns($obj_type_table) $column_name] < 0} {
+ if {$column_name ni $columns($obj_type_table)} {
aa_log_result fail "Type $object_type attribute column $column_name not found in $obj_type_table"
} else {
# check the type of the column is vaguely like the acs_datatype type.
@@ -202,7 +220,7 @@
if {$actual_type eq "-1"} {
aa_log_result fail "Type $object_type attribute $attribute_name database type get for ($table_name.$column_name) failed"
} else {
- if {[lsearch $allow_types($datatype) $actual_type] < 0} {
+ if {$actual_type ni $allow_types($datatype)} {
aa_log_result fail "Type $object_type attribute $attribute_name database type was $actual_type for $datatype"
}
}
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.13 -r1.14
--- openacs-4/packages/acs-tcl/tcl/test/doc-check-procs.tcl 24 Jul 2018 19:29:24 -0000 1.13
+++ openacs-4/packages/acs-tcl/tcl/test/doc-check-procs.tcl 25 Jul 2018 13:42:48 -0000 1.14
@@ -187,12 +187,12 @@
foreach param_doc $params {
set param [lindex [string map $ignorechars $param_doc] 0]
if {"$param" ni $real_params} {
- # Nonexistant @param found!
+ # Nonexistent @param found!
incr param_unknown
aa_log_result fail "Unknown parameter '$param' in documentation of proc '$p'"
}
}
- # Just count the number of procs without nonexistant @params
+ # Just count the number of procs without nonexistent @params
if { $param_unknown == 0 } {
incr good
}
@@ -201,6 +201,63 @@
aa_log "@param names seem coherent with the actual proc parameters in $good of $count checked procs"
}
+if {[parameter::get \
+ -package_id [apm_package_id_from_key acs-api-browser] \
+ -parameter IncludeCallingInfo \
+ -default false]} {
+
+ aa_register_case \
+ -cats {smoke production_safe} \
+ -error_level warning \
+ cross_package_called_private_functions {
+
+ Search for cross-package calls of private functions.
+
+ @author Gustaf Neumann
+
+ @creation-date 2018-07-25
+ } {
+ set count 0
+ set fails 0
+ set private 0
+
+ foreach called [lsort -dictionary [nsv_array names api_proc_doc]] {
+ incr count
+ set called_by_count 0
+ set called_info [nsv_get api_proc_doc $called]
+ if {[dict exists $called_info calledby]
+ && [dict exists $called_info script]
+ && [dict exists $called_info protection]
+ && [dict get $called_info protection] eq "private"
+ } {
+ incr private
+ regexp {^packages/([^/]+)/} [dict get $called_info script] . called_package_key
+ foreach caller [lsort [dict get $called_info calledby]] {
+ incr called_by_count
+ if {[nsv_get api_proc_doc $caller caller_info]
+ && [dict exists $caller_info script]
+ && ![string match "AcsSc.*" $caller]
+ } {
+ regexp {^packages/([^/]+)/} [dict get $caller_info script] . caller_package_key
+ if {$caller_package_key ne $called_package_key} {
+ incr fails
+ set msg ""
+ append msg \
+ "private function <$called_package_key $called> " \
+ "called by <$caller_package_key $caller>some text to probe if it
}
+ aa_log "Original string is $string_with_img"
+ set html_version [ad_enhanced_text_to_html $string_with_img]
+ aa_equals "new: $html_version should be the same" $html_version $string_with_img
+}
+aa_register_case \
+ -cats {api smoke} \
+ -procs {ad_html_to_text} \
+ text_to_html {
+
+ Test code the supposedly causes ad_html_to_text to break
+} {
+
+ # Test bad <<<'s
+
+ set offending_post {><<<}
+ set errno [catch { set text_version [ad_html_to_text -- $offending_post] } errmsg]
+
+ if { ![aa_equals "Does not bomb" $errno 0] } {
+ aa_log "errmsg: $errmsg"
+ aa_log "errorInfo: $::errorInfo"
+ } else {
+ aa_equals "Expected identical result" $text_version $offending_post
+ }
+
+ # Test offending post sent by Dave Bauer
+
+ set offending_post {
+I have a dynamically assigned ip address, so I use dyndns.org to
+change
+addresses for my acs server.
+Mail is sent to any yahoo address fine. Mail sent to aol fails. I am
+not running a dns server on my acs box. What do I need to do to
+correct this problem?