Index: openacs-4/packages/acs-tcl/tcl/test/navigation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/navigation-procs.tcl,v diff -u -r1.15 -r1.16 --- openacs-4/packages/acs-tcl/tcl/test/navigation-procs.tcl 31 Oct 2018 13:54:59 -0000 1.15 +++ openacs-4/packages/acs-tcl/tcl/test/navigation-procs.tcl 3 Sep 2024 15:37:34 -0000 1.16 @@ -8,33 +8,31 @@ namespace eval navigation::test {} -ad_proc navigation::test::context_bar_multirow_filter {} { +ad_proc -private navigation::test::context_bar_multirow_filter {} { Procedure for the context_bar_multirow test filter } { - aa_run_with_teardown -test_code { - set testnode_1 [list "/navigation_test_node1/" "navigation_test_node1"] - set testnode_2 [list "[lindex $testnode_1 0]navigation_test_node2/" "navigation_test_node2"] + aa_run_with_teardown -rollback -test_code { + set testnode_1 [list "/navigation_test_node1/" navigation_test_node1 "GN's Sub-site"] + set testnode_2 [list "[lindex $testnode_1 0]navigation_test_node2/" navigation_test_node2 "navigation_test_node2"] # Create hierarchy from the random created nodes set root_node [site_node::get_from_url -url "/"] set root_node_id [dict get $root_node node_id] # Create and mount new node. We also need a subsite underneath # or the context bar won't display them. - set node_name [lindex $testnode_1 1] - set package_id [site_node::instantiate_and_mount \ + set package_id1 [site_node::instantiate_and_mount \ -parent_node_id $root_node_id \ - -node_name $node_name \ - -package_name $node_name \ + -node_name [lindex $testnode_1 1] \ + -package_name [lindex $testnode_1 2] \ -package_key "acs-subsite"] - set idr_1 [dict get [site_node::get_from_object_id -object_id $package_id] node_id] - set node_name [lindex $testnode_2 1] - set package_id [site_node::instantiate_and_mount \ + set idr_1 [dict get [site_node::get_from_object_id -object_id $package_id1] node_id] + set package_id2 [site_node::instantiate_and_mount \ -parent_node_id $idr_1 \ - -node_name $node_name \ - -package_name $node_name \ + -node_name [lindex $testnode_2 1] \ + -package_name [lindex $testnode_2 2] \ -package_key "acs-subsite"] - set idr_2 [dict get [site_node::get_from_object_id -object_id $package_id] node_id] + set idr_2 [dict get [site_node::get_from_object_id -object_id $package_id2] node_id] set node_id $idr_2 set context "last" @@ -46,13 +44,11 @@ [list context $context]] \ "/packages/acs-tcl/tcl/test/multirow-test"] - site_node::delete -node_id $idr_2 - site_node::delete -node_id $idr_1 - } -teardown_code { site_node::delete -node_id $idr_2 + #apm_package_instance_delete $package_id2 site_node::delete -node_id $idr_1 - + #apm_package_instance_delete $package_id1 } ns_return 200 text/html $page @@ -66,7 +62,7 @@ ad_context_bar_html } ad_context_bar_html { - Test if returns a HTML fragment from a list. + Test if returns an HTML fragment from a list. } { @@ -96,31 +92,35 @@ aa_run_with_teardown -rollback -test_code { + set main_node [site_node::get -url /] + set this_package_id [ad_conn package_id] + set this_package_name [db_string get_name { + select instance_name from apm_packages + where package_id = :this_package_id + }] + # Setup nodes from the context bar, create two random nodes to include set separator "-" set random1 [ad_generate_random_string] - set testnode_1 [list "/$random1/" "ACS Automated Testing"] + set testnode_1 [list "/$random1/" $this_package_name] set random2 [ad_generate_random_string] - set testnode_2 [list "[lindex $testnode_1 0]$random2/" "ACS Automated Testing"] + set testnode_2 [list "[lindex $testnode_1 0]$random2/" $this_package_name] set leave_node "ref_final" - set root_node [list "/" \#acs-kernel.Main_Site\#] + set root_node [list "/" [dict get $main_node instance_name]] if { [string match "admin/*" [ad_conn extra_url]] } { set admin_node [list "[ad_conn package_url]admin/" [_ acs-tcl.Administration]] } else { set admin_node "" } # Create hierarchy from the random created nodes - db_1row query { - select min(node_id) as first_node from site_nodes - } - set idp $first_node + set idp [dict get $main_node node_id] set idr_1 [site_node::new -name $random1 -parent_id $idp] set idr_2 [site_node::new -name $random2 -parent_id $idr_1] - site_node::mount -node_id $idr_1 -object_id [ad_conn package_id] - site_node::mount -node_id $idr_2 -object_id [ad_conn package_id] + site_node::mount -node_id $idr_1 -object_id $this_package_id + site_node::mount -node_id $idr_2 -object_id $this_package_id aa_log "Created two test sites nodes: testnode_1 = [lindex $testnode_1 1],\n\ testnode_2 = [lindex $testnode_2 1]n\ testnode_2 is a child of testnode_1" @@ -139,40 +139,53 @@ # Case 1: node_id = testnode_1 #----------------------------------------------------------------------- aa_log "Case 1: node_id = testnode_1 <$testnode_1>" - set bar_components [list $root_node $testnode_1 $admin_node] + set bar_components [list $root_node $testnode_1] + if {$admin_node ne ""} { + lappend bar_components $admin_node + } #aa_log "bar_components $bar_components" set context_barp "" foreach value $bar_components { append context_barp \ - [subst {[lindex $value 1] $separator }] + [subst {[ns_quotehtml [lindex $value 1]] $separator }] } append context_barp "$leave_node" set context_bar [ad_context_bar -node_id $idr_1 -separator $separator $leave_node] # Test - aa_log "ad_context_bar 1: '$context_bar'\nad_context_bar 2: '$context_barp'" + set msg [ns_quotehtml "ad_context_bar 1: '$context_bar'\nad_context_bar 2: '$context_barp'"] + aa_log "
$msg
" aa_equals "Context_bar = $context_barp" $context_bar $context_barp #----------------------------------------------------------------------- # Case 2: node_id = testnode_2 (testnode2 is a testnode_1 children) #----------------------------------------------------------------------- aa_log "Case 2: node_id = testnode_2 (testnode2 is a testnode_1 children)" - set bar_components [list $root_node $testnode_1 $testnode_2 $admin_node] + set bar_components [list $root_node $testnode_1 $testnode_2] + if {$admin_node ne ""} { + lappend bar_components $admin_node + } set context_barp "" foreach value $bar_components { append context_barp \ - [subst {[lindex $value 1] $separator }] + [subst {[ns_quotehtml [lindex $value 1]] $separator }] } append context_barp "$leave_node" set context_bar [ad_context_bar -node_id $idr_2 -separator $separator $leave_node] + set msg [ns_quotehtml "ad_context_bar 1: '$context_bar'\nad_context_bar 2: '$context_barp'"] + aa_log "
$msg
" + aa_equals "Context_bar = $context_barp" $context_bar $context_barp #---------------------------------------------------------------------------- # Case 3: from_node = testnode_1 and node_id = testnode_2 #---------------------------------------------------------------------------- aa_log "Case 3: from_node = testnode_1 and node_id = testnode_2" - set bar_components [list $testnode_1 $testnode_2 $admin_node] + set bar_components [list $testnode_1 $testnode_2] + if {$admin_node ne ""} { + lappend bar_components $admin_node + } set context_barp "" foreach value $bar_components { append context_barp \ @@ -188,6 +201,14 @@ -cats {api smoke web} \ -procs { ad_context_bar_multirow + acs::test::http + acs::test::reply_has_status_code + lang::system::site_wide_locale + lang::util::localize + navigation::test::context_bar_multirow_filter + site_node::get + + db_1row } \ ad_context_bar_multirow { @@ -196,9 +217,10 @@ } { # Setup nodes from the context bar, create two nodes to include set separator "" - set testnode_1 [list "/navigation_test_node1/" "navigation_test_node1"] + set testnode_1 [list "/navigation_test_node1/" "GN's Sub-site"] set testnode_2 [list "[lindex $testnode_1 0]navigation_test_node2/" "navigation_test_node2"] - set root_node [list "/" [_ acs-kernel.Main_Site]] + set main_node [site_node::get -url /] + set root_node [list "/" [lang::util::localize [dict get $main_node instance_name] [lang::system::site_wide_locale]]] set last_node [list "" "last"] set bar_components [list $root_node $testnode_1 $testnode_2 $last_node] @@ -207,7 +229,7 @@ append context_barp "" - append context_barp [lindex $value 1] + append context_barp [ns_quotehtml [lindex $value 1]] append context_barp "" } ns_register_proc GET /test.testf { @@ -218,11 +240,61 @@ ns_unregister_op GET /test.testf set response_body [dict get $d body] - ns_log notice "CONTEXT BARP $context_barp" - ns_log notice "RESPONS BODY $response_body" + #ns_log notice "CONTEXT BARP $context_barp" + #ns_log notice "RESPONSE BODY $response_body" aa_equals "Context bar" [ns_quotehtml $response_body] [ns_quotehtml $context_barp] } +aa_register_case \ + -cats {api smoke production_safe} \ + -procs { + ad_navbar + ad_choice_bar + } \ + ad_html_bars { + + Test procs that produce some HTML bar from a list of options. + + } { + aa_section "ad_choice_bar" + + set items {1 2 3 4} + set links {a b c d} + set values {} + aa_equals "With no values, proc returns nothing" \ + [ad_choice_bar $items $links $values] "" + + set items {1 2 3 4} + set links {a b c d} + set values {what ever we want to do} + set bar [ad_choice_bar $items $links $values] + aa_equals "The 'values' argument decides the number of elements" \ + [regsub -all -- {} $bar {} _] [llength $values] + foreach i $items l $links { + aa_true "'$i' was rendered" {[string first $i $bar] >= 0} + aa_true "'$l' was rendered" {[string first $l $bar] >= 0} + } + + set items {1 2 3 4} + set links {a b c d} + set values {what ever we want to do} + set selected what + aa_true "The item corresponding to the selected value is emphasized" \ + {[string first 1 [ad_choice_bar $items $links $values $selected]] >= 0} + + aa_section "ad_navbar" + + set items {{a 1} {b 2} {c 3} {d 4}} + set bar [ad_navbar {*}$items] + aa_equals "A link is generated for every item in the arguments" \ + [regsub -all -- {} $bar {} _] [llength $items] + foreach i $items { + lassign $i link label + aa_true "'$link' was rendered" {[string first $link $bar] >= 0} + aa_true "'$label' was rendered" {[string first $label $bar] >= 0} + } + } + # Local variables: # mode: tcl # tcl-indent-level: 4