Index: openacs-4/packages/acs-lang/tcl/test/acs-lang-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/test/acs-lang-test-procs.tcl,v diff -u -r1.20 -r1.21 --- openacs-4/packages/acs-lang/tcl/test/acs-lang-test-procs.tcl 29 Dec 2017 11:13:40 -0000 1.20 +++ openacs-4/packages/acs-lang/tcl/test/acs-lang-test-procs.tcl 29 Dec 2017 11:17:34 -0000 1.21 @@ -44,7 +44,7 @@ $package_name f f - + Peter Marklund Temporary acs-lang test package @@ -86,9 +86,9 @@ upvar $db_array db_messages upvar $file_array file_messages - # Check that we have the expected message properties in the database after upgrade + # Check that we have the expected message properties in the database after upgrade foreach message_key [lsort [array names upgrade_expect]] { - array set expect_property $upgrade_expect($message_key) + array set expect_property $upgrade_expect($message_key) switch $expect_property(message) { db { set expect_message $db_messages($message_key) @@ -116,7 +116,7 @@ $message_actual(upgrade_status) $expect_property(upgrade_status) if {$expect_property(sync_time) eq "not_null"} { aa_true "Import check: $message_key - lang_messages.sync_time not null" \ - [expr {$message_actual(sync_time) ne ""}] + [expr {$message_actual(sync_time) ne ""}] } else { aa_true "Import check: $message_key - lang_messages.sync_time null" \ [expr {$message_actual(sync_time) eq ""}] @@ -352,7 +352,7 @@ if { ![info exists base_messages($message_key)] || $base_messages($message_key) ne $db_messages($message_key) } { - # Added || updated + # Added || updated aa_log "Adding/updating message $message_key" lang::message::register \ $locale \ @@ -450,7 +450,7 @@ #---------------------------------------------------------------------- aa_log "locale=$locale ----------9. Check results of third upgrade (that resolutions are sticky)----------" foreach message_key [array names conflict_resolutions] { - + array unset message_array lang::message::get \ -package_key $package_key \ @@ -467,11 +467,11 @@ aa_register_case \ -procs { - lang::util::replace_temporary_tags_with_lookups - lang::catalog::export_messages_to_file - lang::catalog::parse - lang::catalog::read_file - lang::util::get_temporary_tags_indices + lang::util::replace_temporary_tags_with_lookups + lang::catalog::export_messages_to_file + lang::catalog::parse + lang::catalog::read_file + lang::util::get_temporary_tags_indices } util__replace_temporary_tags_with_lookups { A test Tcl file and catalog file are created. The temporary tags in the @@ -483,7 +483,7 @@ } { # Peter NOTE: cannot get this test case to work with the rollback code in automated testing # and couldn't track down why. I'm threrefor resorting to manual teardown which is fragile and hairy - + # The files involved in the test set package_key acs-lang set test_dir [lang::test::get_dir] @@ -498,10 +498,10 @@ # The test messages to use for the catalog file array set messages_array [list key_1 text_1 key_2 text_2 key_3 text_3] # NOTE: must be kept up-to-date for teardown to work - set expected_new_keys [list Auto_Key key_1_1] + set expected_new_keys [list Auto_Key key_1_1] # Write the test Tcl file - set tcl_file_id [open "$::acs::rootdir/$tcl_file" w] + set tcl_file_id [open "$::acs::rootdir/$tcl_file" w] set new_key_1 "_" set new_text_1 "Auto Key" set new_key_2 "key_1" @@ -536,7 +536,7 @@ array set updated_messages_array $catalog_array(messages) # Assert that the old messages are unchanged - foreach old_message_key [array names messages_array] { + foreach old_message_key [array names messages_array] { aa_true "old key $old_message_key should be unchanged" [string equal $messages_array($old_message_key) \ $updated_messages_array($old_message_key)] } @@ -547,7 +547,7 @@ # Check that the second new key was made unique and inserted aa_true "check key made unique" [string equal $updated_messages_array(${new_key_2}_1) $new_text_2] - # Check that the third key was not inserted + # Check that the third key was not inserted aa_true "third key not inserted" [string equal [lindex [array get updated_messages_array $new_key_3] 1] \ $messages_array($new_key_3)] @@ -572,12 +572,12 @@ aa_register_case \ -procs { - lang::util::get_hash_indices + lang::util::get_hash_indices } util__get_hash_indices { @author Peter Marklund (peter@collaboraid.biz) @creation-date 21 October 2002 -} { +} { set multilingual_string "#package1.key1# abc\# #package2.key2#" set indices_list [lang::util::get_hash_indices $multilingual_string] set expected_indices_list [list [list 0 14] [list 21 35]] @@ -587,19 +587,19 @@ set counter 0 foreach index_item $indices_list { set expected_index_item [lindex $expected_indices_list $counter] - + aa_true "checking start and end indices of item $counter" \ - [expr {[lindex $index_item 0] eq [lindex $expected_index_item 0] - && [lindex $index_item 1] eq [lindex $expected_index_item 1]}] + [expr {[lindex $index_item 0] eq [lindex $expected_index_item 0] + && [lindex $index_item 1] eq [lindex $expected_index_item 1]}] set counter [expr {$counter + 1}] } } aa_register_case \ -procs { - lang::util::convert_adp_variables_to_percentage_signs - lang::util::convert_percentage_signs_to_adp_variables + lang::util::convert_adp_variables_to_percentage_signs + lang::util::convert_percentage_signs_to_adp_variables } util__convert_adp_variables_to_percentage_signs { @author Peter Marklund (peter@collaboraid.biz) @@ -628,7 +628,7 @@ aa_register_case \ -procs { - lang::util::replace_adp_text_with_message_tags + lang::util::replace_adp_text_with_message_tags } util__replace_adp_text_with_message_tags { @author Peter Marklund (peter@collaboraid.biz) @@ -667,9 +667,9 @@ } aa_register_case \ - -procs { - lang::message::format - } message__format { + -procs { + lang::message::format + } message__format { @author Peter Marklund (peter@collaboraid.biz) @creation-date 21 October 2002 @@ -691,9 +691,9 @@ } aa_register_case \ - -procs { - lang::message::get_embedded_vars - } message__get_embedded_vars { + -procs { + lang::message::get_embedded_vars + } message__get_embedded_vars { @author Peter Marklund (peter@collaboraid.biz) @creation-date 12 November 2002 @@ -729,22 +729,22 @@ [lang::message::get_embedded_vars $en_us_message]] if { ![aa_equals "No missing vars" [llength $missing_vars_list] 0] } { aa_log "Missing vars: $missing_vars_list" - } + } } aa_register_case \ - -procs { - lang::system::set_locale - lang::system::locale - lang::system::site_wide_locale - } locale__test_system_package_setting { + -procs { + lang::system::set_locale + lang::system::locale + lang::system::site_wide_locale + } locale__test_system_package_setting { Tests whether the system package level setting works @author Lars Pind (lars@collaboraid.biz) @creation-date 2003-08-12 } { set use_package_level_locales_p_org [parameter::get -parameter UsePackageLevelLocalesP -package_id [apm_package_id_from_key "acs-lang"]] - + parameter::set_value -parameter UsePackageLevelLocalesP -package_id [apm_package_id_from_key "acs-lang"] -value 1 @@ -753,17 +753,17 @@ set locale_to_set [ad_generate_random_string] set retrieved_locale {} - + ad_try { # Let's pick a random unmounted package to test with set package_id [apm_package_id_from_key "acs-kernel"] - + set org_setting [lang::system::site_wide_locale] - + lang::system::set_locale -package_id $package_id $locale_to_set - + set retrieved_locale [lang::system::locale -package_id $package_id] - + } on error {errorMsg} { # rethrow error error $errorMsg $::errorInfo @@ -773,14 +773,14 @@ -package_id [apm_package_id_from_key "acs-lang"] \ -value $use_package_level_locales_p_org } - + aa_true "Retrieved system locale ('$retrieved_locale') equals the one we just set ('$locale_to_set')" [string equal $locale_to_set $retrieved_locale] } aa_register_case \ - -procs { - lang::conn::browser_locale - } locale__test_lang_conn_browser_locale { + -procs { + lang::conn::browser_locale + } locale__test_lang_conn_browser_locale { @author Peter Marklund @creation-date 2003-08-13 @@ -799,47 +799,47 @@ # First locale is perfect language match lang::test::assert_browser_locale "da,en-us;q=0.8,de;q=0.5,es;q=0.3" "da_DK" - + # First locale is perfect locale match lang::test::assert_browser_locale "da_DK,en-us;q=0.8,de;q=0.5,es;q=0.3" "da_DK" - + # Tentative match being discarded lang::test::assert_browser_locale "da_BLA,foobar,en" "en_US" - + # Tentative match being used lang::test::assert_browser_locale "da_BLA,foobar" "da_DK" - + # Several tentative matches, all being discarded lang::test::assert_browser_locale "da_BLA,foobar,da_BLUB,da_DK" "da_DK" } } aa_register_case \ - -cats db \ - strange_oracle_problem { + -cats db \ + strange_oracle_problem { Strange Oracle problem when selecting by language - + } { set language "da " set locale da_DK - set db_string [db_string select_default_locale { - select locale - from ad_locales + set db_string [db_string select_default_locale { + select locale + from ad_locales where language = :language } -default "WRONG"] - + aa_false "Does not return 'WRONG'" [string equal $db_string "WRONG"] } aa_register_case \ - -procs { - lang::user::set_timezone - lang::system::set_timezone - lang::system::timezone - } set_get_timezone { + -procs { + lang::user::set_timezone + lang::system::set_timezone + lang::system::timezone + } set_get_timezone { Test that setting and getting user timezone works } { @@ -862,30 +862,30 @@ set timezones [lc_list_all_timezones] set n [expr {[llength $timezones]-1}] - + set desired_user_timezone [lindex [lindex $timezones [randomRange $n]] 0] set desired_system_timezone [lindex [lindex $timezones [randomRange $n]] 0] - + set error_p 0 ad_try { # User timezone lang::user::set_timezone $desired_user_timezone aa_equals "User timezone retrieved is the same as the one set" [lang::user::timezone] $desired_user_timezone - + # Storage set user_id [ad_conn user_id] aa_equals "User timezone stored in user_preferences table" \ [db_string user_prefs { select timezone from user_preferences where user_id = :user_id }] \ $desired_user_timezone - - + + # System timezone lang::system::set_timezone $desired_system_timezone aa_equals "System timezone retrieved is the same as the one set" [lang::system::timezone] $desired_system_timezone - + # Connection timezone aa_equals "Using user timezone" [lang::conn::timezone] $desired_user_timezone - + ad_conn -set isconnected 0 aa_equals "Fallback to system timezone when no connection" [lang::conn::timezone] $desired_system_timezone ad_conn -set isconnected 1 @@ -907,10 +907,10 @@ } aa_register_case \ - -procs { - lang::user::set_timezone - lang::system::timezone - } set_timezone_not_logged_in { + -procs { + lang::user::set_timezone + lang::system::timezone + } set_timezone_not_logged_in { Test that setting and getting user timezone throws an error when user is not logged in } { # We cannot test timezones if they are not installed @@ -924,7 +924,7 @@ set error_p [catch { lang::user::set_timezone [lang::system::timezone] } errmsg] aa_true "Error when setting user timezone when user not logged in" $error_p - # Reset the user_id + # Reset the user_id ad_conn -set user_id $user_id } } @@ -937,29 +937,29 @@ aa_register_case \ -procs { - lang::message::lookup + lang::message::lookup } locale_language_fallback { - Test that we fall back to 'default locale for language' when requesting a message + Test that we fall back to 'default locale for language' when requesting a message which exists in default locale for language, but not in the current locale } { # Assuming we have en_US and en_GB - + set package_key "acs-lang" set message_key [ad_generate_random_string] set us_message [ad_generate_random_string] set gb_message [ad_generate_random_string] - + set error_p 0 ad_try { lang::message::register "en_US" $package_key $message_key $us_message - + aa_equals "Looking up message in GB returns US message" \ [lang::message::lookup "en_GB" "$package_key.$message_key" "NOT FOUND"] \ $us_message lang::message::register "en_GB" $package_key $message_key $gb_message - + aa_equals "Looking up message in GB returns GB message" \ [lang::message::lookup "en_GB" "$package_key.$message_key" "NOT FOUND"] \ $gb_message @@ -977,9 +977,9 @@ aa_register_case \ -procs { - lang::catalog::import - lang::message::edit - lang::message::get + lang::catalog::import + lang::message::edit + lang::message::get } upgrade { Test that a package can be upgraded with new catalog files and that the resulting keys and messages @@ -1007,10 +1007,10 @@ lang::test::execute_upgrade -locale de_DE - } -teardown_code { + } -teardown_code { foreach message_key [array names upgrade_expect] { lang::message::unregister $package_key $message_key - } + } lang::test::teardown_test_package } } @@ -1063,11 +1063,11 @@ This test calls the checks to ensure a message is correct on every message in the system } { aa_run_with_teardown -rollback -test_code { - db_foreach query " - select message_key, package_key, locale, message from lang_messages" { - aa_false "Message $message_key in package $package_key for locale $locale correct" \ - [catch {lang::message::check $locale $package_key $message_key $message}] - } + db_foreach query " + select message_key, package_key, locale, message from lang_messages" { + aa_false "Message $message_key in package $package_key for locale $locale correct" \ + [catch {lang::message::check $locale $package_key $message_key $message}] + } } }