- Publicity: Public Only All
acs-lang-test-procs.tcl
Helper test Tcl procedures.
- Location:
- packages/acs-lang/tcl/test/acs-lang-test-procs.tcl
- Created:
- 18 October 2002
- Author:
- Peter Marklund <peter@collaboraid.biz>
Procedures in this file
- _acs-lang__acs_lang_exec_dependencies (private)
- _acs-lang__catalog_files_are_tdom_parsable_xml (private)
- _acs-lang__default_locale_from_lang (private)
- _acs-lang__lang_message_dependencies_are_fine (private)
- _acs-lang__lang_messages_correct (private)
- _acs-lang__lang_package_has_files_in_locale_p (private)
- _acs-lang__lc_time_fmt_Z_timezone (private)
- _acs-lang__locale__test_lang_conn_browser_locale (private)
- _acs-lang__locale__test_system_package_setting (private)
- _acs-lang__locale_language_fallback (private)
- _acs-lang__localize (private)
- _acs-lang__message__format (private)
- _acs-lang__message__get_embedded_vars (private)
- _acs-lang__set_get_timezone (private)
- _acs-lang__set_timezone_not_logged_in (private)
- _acs-lang__upgrade (private)
- _acs-lang__util__convert_adp_variables_to_percentage_signs (private)
- _acs-lang__util__get_hash_indices (private)
- _acs-lang__util__replace_adp_text_with_message_tags (private)
- _acs-lang__util__replace_temporary_tags_with_lookups (private)
- lang::test::assert_browser_locale (private)
- lang::test::check_import_result (private)
- lang::test::execute_upgrade (private)
- lang::test::get_all_package_files (private)
- lang::test::get_dir (private)
- lang::test::setup_test_package (private)
- lang::test::teardown_test_package (private)
- lang::test::test_package_key (private)
Detailed information
_acs-lang__acs_lang_exec_dependencies (private)
_acs-lang__acs_lang_exec_dependencies
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__catalog_files_are_tdom_parsable_xml (private)
_acs-lang__catalog_files_are_tdom_parsable_xml
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__default_locale_from_lang (private)
_acs-lang__default_locale_from_lang
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__lang_message_dependencies_are_fine (private)
_acs-lang__lang_message_dependencies_are_fine
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__lang_messages_correct (private)
_acs-lang__lang_messages_correct
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__lang_package_has_files_in_locale_p (private)
_acs-lang__lang_package_has_files_in_locale_p
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__lc_time_fmt_Z_timezone (private)
_acs-lang__lc_time_fmt_Z_timezone
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__locale__test_lang_conn_browser_locale (private)
_acs-lang__locale__test_lang_conn_browser_locale
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__locale__test_system_package_setting (private)
_acs-lang__locale__test_system_package_setting
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__locale_language_fallback (private)
_acs-lang__locale_language_fallback
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__localize (private)
_acs-lang__localize
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__message__format (private)
_acs-lang__message__format
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__message__get_embedded_vars (private)
_acs-lang__message__get_embedded_vars
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__set_get_timezone (private)
_acs-lang__set_get_timezone
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__set_timezone_not_logged_in (private)
_acs-lang__set_timezone_not_logged_in
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__upgrade (private)
_acs-lang__upgrade
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__util__convert_adp_variables_to_percentage_signs (private)
_acs-lang__util__convert_adp_variables_to_percentage_signs
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__util__get_hash_indices (private)
_acs-lang__util__get_hash_indices
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__util__replace_adp_text_with_message_tags (private)
_acs-lang__util__replace_adp_text_with_message_tags
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
_acs-lang__util__replace_temporary_tags_with_lookups (private)
_acs-lang__util__replace_temporary_tags_with_lookups
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
lang::test::assert_browser_locale (private)
lang::test::assert_browser_locale accept_language expect_locale
Assert that with given accept language header lang::conn::browser_locale returns the expected locale.
- Parameters:
- accept_language (required)
- expect_locale (required)
- Author:
- Peter Marklund
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- locale__test_lang_conn_browser_locale
lang::test::check_import_result (private)
lang::test::check_import_result -package_key package_key \ -locale locale -upgrade_array upgrade_array -base_array base_array \ -db_array db_array -file_array file_array
This proc checks that the properties of messages in the database are what we expect after a message catalog import or upgrade.
- Switches:
- -package_key (required)
- -locale (required)
- -upgrade_array (required)
- -base_array (required)
- -db_array (required)
- -file_array (required)
- Author:
- Peter Marklund
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
lang::test::execute_upgrade (private)
lang::test::execute_upgrade -locale locale
Executes the logic of the upgrade test case for a certain locale.
- Switches:
- -locale (required)
- Author:
- Peter Marklund
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- upgrade
lang::test::get_all_package_files (private)
lang::test::get_all_package_files
Get all files on the system where some message key is expected.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
lang::test::get_dir (private)
lang::test::get_dir
The test directory of the acs-lang package (where this file resides).
- Author:
- Peter Marklund <peter@collaboraid.biz>
- Created:
- 28 October 2002
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- util__replace_temporary_tags_with_lookups, util__replace_adp_text_with_message_tags
lang::test::setup_test_package (private)
lang::test::setup_test_package
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- upgrade
lang::test::teardown_test_package (private)
lang::test::teardown_test_package
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- upgrade
lang::test::test_package_key (private)
lang::test::test_package_key
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
Content File Source
ad_library { Helper test Tcl procedures. @author Peter Marklund (peter@collaboraid.biz) @creation-date 18 October 2002 } namespace eval lang::test {} ad_proc -private lang::test::get_dir {} { The test directory of the acs-lang package (where this file resides). @author Peter Marklund (peter@collaboraid.biz) @creation-date 28 October 2002 } { return "[acs_package_root_dir acs-lang]/tcl/test" } ad_proc -private lang::test::assert_browser_locale {accept_language expect_locale} { Assert that with given accept language header lang::conn::browser_locale returns the expected locale. @author Peter Marklund } { ns_set update [ns_conn headers] "Accept-Language" $accept_language set browser_locale [lang::conn::browser_locale] aa_equals "accept-language header \"$accept_language\"" $browser_locale $expect_locale } ad_proc -private lang::test::test_package_key {} { return "acs-lang-test-tmp" } ad_proc -private lang::test::setup_test_package {} { set package_key [test_package_key] set package_name "acs-lang temporary test package" set package_dir [file join $::acs::rootdir packages $package_key] file mkdir $package_dir set info_file_path "${package_dir}/${package_key}.info" set info_file_contents "<?xml version=\"1.0\"?> <package key=\"$package_key\" url=\"http://www.openacs.org/acs-repository/apm/packages/$package_key\" type=\"apm_service\"> <package-name>$package_name</package-name> <pretty-plural>$package_name</pretty-plural> <initial-install-p>f</initial-install-p> <singleton-p>f</singleton-p> <version name=\"1.0\" url=\"http://www.openacs.org/acs-repository/download/apm/$package_key-1.0.apm\"> <owner url=\"mailto:peter@collaboraid.biz\">Peter Marklund</owner> <summary>Temporary acs-lang test package</summary> <release-date>2003-11-07</release-date> <vendor url=\"http://www.collaboraid.biz\">Collaboraid</vendor> <description format=\"text/plain\">Temporary test package created by acs-lang test case.</description> </version> </package> " template::util::write_file $info_file_path $info_file_contents # Install the test package without catalog files apm_package_install \ -enable \ [apm_package_info_file_path $package_key] aa_true "Package install: package enabled" \ {$package_key in [apm_enabled_packages]} } ad_proc -private lang::test::teardown_test_package {} { apm_package_delete -remove_files=1 [test_package_key] } d_proc -private lang::test::check_import_result { {-package_key:required} {-locale:required} {-upgrade_array:required} {-base_array:required} {-db_array:required} {-file_array:required} } { This proc checks that the properties of messages in the database are what we expect after a message catalog import or upgrade. @author Peter Marklund } { upvar $upgrade_array upgrade_expect upvar $base_array base_messages upvar $db_array db_messages upvar $file_array file_messages # Check that we have the expected message properties in the database after upgrade foreach message_key [lsort [array names upgrade_expect]] { set expected_property $upgrade_expect($message_key) switch [dict get $expected_property message] { db { set expect_message $db_messages($message_key) } file { set expect_message $file_messages($message_key) } base { set expect_message $base_messages($message_key) } } unset -nocomplain message_actual lang::message::get \ -package_key $package_key \ -message_key $message_key \ -locale $locale \ -array message_actual # Check message properties aa_equals "Import check: $message_key - lang_messages.message" \ $message_actual(message) \ $expect_message aa_equals "Import check: $message_key - lang_messages.deleted_p" \ $message_actual(deleted_p) \ [dict get $expected_property deleted_p] aa_equals "Import check: $message_key - lang_messages.conflict_p" \ $message_actual(conflict_p) \ [dict get $expected_property conflict_p] aa_equals "Import check: $message_key - lang_messages.upgrade_status" \ $message_actual(upgrade_status) \ [dict get $expected_property upgrade_status] if {[dict get $expected_property sync_time] eq "not_null"} { aa_true "Import check: $message_key - lang_messages.sync_time not null" \ {$message_actual(sync_time) ne ""} } else { aa_true "Import check: $message_key - lang_messages.sync_time null" \ {$message_actual(sync_time) eq ""} } } } d_proc -private lang::test::execute_upgrade { {-locale:required} } { Executes the logic of the upgrade test case for a certain locale. @author Peter Marklund } { set package_key [lang::test::test_package_key] # The key numbers correspond to the 14 cases described in the API-doc for lang::catalog::upgrade array set base_messages { key01 "Key 1" key04 "Key 4" key05 "Key 5" key06 "Key 6" key07 "Key 7" key10 "Key 10" key11 "Key 11" key12 "Key 12" key13 "Key 13 differ" key14 "Key 14 base" } array set db_messages { key02 "Key 2" key06 "Key 6 differ" key07 "Key 7" key08 "Key 8" key09 "Key 9" key10 "Key 10" key11 "Key 11 differ" key12 "Key 12" key13 "Key 13" key14 "Key 14 db" } array set file_messages { key03 "Key 3" key04 "Key 4 differ" key05 "Key 5" key08 "Key 8 differ" key09 "Key 9" key10 "Key 10" key11 "Key 11" key12 "Key 12 differ" key13 "Key 13" key14 "Key 14 file" } # Add the locale to each message so we can tell messages in # different locales apart foreach array_name {base_messages db_messages file_messages} { foreach message_key [array names $array_name] { append ${array_name}($message_key) " $locale" } } array set upgrade_expect { key01 { message base deleted_p t conflict_p f sync_time not_null upgrade_status no_upgrade } key02 { message db deleted_p f conflict_p f sync_time null upgrade_status no_upgrade } key03 { message file deleted_p f conflict_p f sync_time not_null upgrade_status added } key04 { message file deleted_p f conflict_p t sync_time not_null upgrade_status added } key05 { message base deleted_p t conflict_p f sync_time null upgrade_status no_upgrade } key06 { message db deleted_p t conflict_p t sync_time not_null upgrade_status deleted } key07 { message db deleted_p t conflict_p f sync_time not_null upgrade_status deleted } key08 { message file deleted_p f conflict_p t sync_time not_null upgrade_status updated } key09 { message db deleted_p f conflict_p f sync_time not_null upgrade_status no_upgrade } key10 { message db deleted_p f conflict_p f sync_time not_null upgrade_status added } key11 { message db deleted_p f conflict_p f sync_time null upgrade_status no_upgrade } key12 { message file deleted_p f conflict_p f sync_time not_null upgrade_status updated } key13 { message db deleted_p f conflict_p f sync_time not_null upgrade_status no_upgrade } key14 { message file deleted_p f conflict_p t sync_time not_null upgrade_status updated } } # # Execution plan: # # 1. Import some messages (base_messages below) # 2. Make changes to DB (db_messages below) # 3. Make changes to catalog files and import again (file_messages below) # 4. Check that merged result is what we expect (upgrade_expect below) # 5. Import again # 6. Check that we still have the same result (verify idempotent) # 7. Resolve some conflicts, but not all # 8. Import again # 9. Check that we have what's expected then # aa_log "-------------------------------------------------------------------" aa_log "*** Executing upgrade test with locale $locale" aa_log "-------------------------------------------------------------------" #---------------------------------------------------------------------- # 1. Import some messages (base_messages) #---------------------------------------------------------------------- aa_log "locale=$locale ----------1. import some messages----------" # Write original catalog file set catalog_file_path [lang::catalog::get_catalog_file_path \ -package_key $package_key \ -locale $locale] lang::catalog::export_to_file $catalog_file_path [array get base_messages] aa_true "Initial export: messages exported to file $catalog_file_path" [file exists $catalog_file_path] aa_log [template::util::read_file $catalog_file_path] # Import the catalog file aa_silence_log_entries -severities {error} { set message_count [lang::catalog::import -package_key $package_key -locales [list $locale]] } aa_log "Imported messages: $message_count" # Check that we have the expected messages in the database set actual_db_messages [lang::catalog::messages_in_db -package_key $package_key -locale $locale] foreach message_key [lsort [array names base_messages]] { aa_equals "Initial import: message for key $message_key in db same as in file" \ [dict get $actual_db_messages $message_key] $base_messages($message_key) } #---------------------------------------------------------------------- # 2. Make changes to DB (db_messages) #---------------------------------------------------------------------- aa_log "locale=$locale ----------2. Make changes to DB----------" # Carry out changes to the message catalog in the db foreach message_key [lsort [array names upgrade_expect]] { set register_p 0 if { ![info exists db_messages($message_key)] } { # Message is not supposed to exist in DB if { [info exists base_messages($message_key)] } { # Message currently does exist in DB: Delete aa_log "Deleting message $message_key" lang::message::delete \ -package_key $package_key \ -message_key $message_key \ -locale $locale # Test undelete after deleting for the first time aa_log "Undeleting message $message_key" lang::message::undelete \ -package_key $package_key \ -message_key $message_key \ -locale $locale # Delete the message again aa_log "Deleting message $message_key definitively" lang::message::delete \ -package_key $package_key \ -message_key $message_key \ -locale $locale } } else { # Message is supposed to exist in DB # Is it new or changed? if { ![info exists base_messages($message_key)] || $base_messages($message_key) ne $db_messages($message_key) } { # Added || updated aa_log "Adding/updating message $message_key" lang::message::register \ $locale \ $package_key \ $message_key \ $db_messages($message_key) } } } #---------------------------------------------------------------------- # 3. Make changes to catalog files and import again (file_messages) #---------------------------------------------------------------------- aa_log "locale=$locale ----------3. Make changes to catalog files and do first upgrade----------" # Update the catalog file file delete -force -- $catalog_file_path lang::catalog::export_to_file $catalog_file_path [array get file_messages] aa_true "First upgrade: catalog file $catalog_file_path updated" [file exists $catalog_file_path] # Execute a first upgrade lang::catalog::import -package_key $package_key -locales [list $locale] #---------------------------------------------------------------------- # 4. Check that merged result is what we expect (upgrade_expect) #---------------------------------------------------------------------- aa_log "locale=$locale ----------4. Check merge result of first upgrade----------" lang::test::check_import_result \ -package_key $package_key \ -locale $locale \ -upgrade_array upgrade_expect \ -base_array base_messages \ -db_array db_messages \ -file_array file_messages #---------------------------------------------------------------------- # 5. First upgrade (second import) #---------------------------------------------------------------------- aa_log "locale=$locale ----------5. Second upgrade ----------" lang::catalog::import -package_key $package_key -locales [list $locale] #---------------------------------------------------------------------- # 6. Check that we still have the same result (verify idempotent) #---------------------------------------------------------------------- aa_log "locale=$locale ----------6. Check merge results of second upgrade (verify idempotent)----------" lang::test::check_import_result \ -package_key $package_key \ -locale $locale \ -upgrade_array upgrade_expect \ -base_array base_messages \ -db_array db_messages \ -file_array file_messages #---------------------------------------------------------------------- # 7. Resolve some conflicts, but not all #---------------------------------------------------------------------- aa_log "locale=$locale ----------7. Resolve some conflicts, but not all----------" array set conflict_resolutions { key06 "key06 resolution message" key08 "accept" } foreach message_key [array names conflict_resolutions] { if {$conflict_resolutions($message_key) eq "accept"} { # Resolution is an accept - just toggle conflict_p flag lang::message::edit $package_key $message_key $locale [list conflict_p f] # Set the message to be what's in the database (the accepted message) set conflict_resolutions($message_key) [lang::message::get_element \ -package_key $package_key \ -message_key $message_key \ -locale $locale \ -element message] } else { # Resolution is an edit lang::message::register \ $locale \ $package_key \ $message_key \ $conflict_resolutions($message_key) } } # TODO: test resolution being to retain the message (just toggle conflict_p) # TODO: test resolution being to delete a resurrected message # TODO: test other resolution possibilities #---------------------------------------------------------------------- # 8. Third upgrade #---------------------------------------------------------------------- aa_log "locale=$locale ----------8. Do third upgrade----------" lang::catalog::import -package_key $package_key -locales [list $locale] #---------------------------------------------------------------------- # 9. Check that we have what's expected then (resolutions are sticky) #---------------------------------------------------------------------- aa_log "locale=$locale ----------9. Check results of third upgrade (that resolutions are sticky)----------" foreach message_key [array names conflict_resolutions] { unset -nocomplain message_array lang::message::get \ -package_key $package_key \ -message_key $message_key \ -locale $locale \ -array message_array aa_equals "$message_key - conflict message that has been resolved in UI has conflict_p=f" \ $message_array(conflict_p) "f" aa_equals "$message_key - the resolved conflict is not clobbered by an additional import" \ $message_array(message) $conflict_resolutions($message_key) } } aa_register_case \ -procs { lang::catalog::export_to_file lang::catalog::package_catalog_dir lang::catalog::parse lang::catalog::read_file lang::message::unregister lang::test::get_dir lang::util::get_temporary_tags_indices lang::util::replace_temporary_tags_with_lookups aa_stub aa_unstub } util__replace_temporary_tags_with_lookups { A test Tcl file and catalog file are created. The temporary tags in the Tcl file are replaced with message lookups and keys and messages are appended to the catalog file. @author Peter Marklund (peter@collaboraid.biz) @creation-date 18 October 2002 } { # 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] set catalog_dir [lang::catalog::package_catalog_dir $package_key] set catalog_file "${catalog_dir}/acs-lang.xxx_xx.ISO-8859-1.xml" set backup_file_suffix ".orig" set catalog_backup_file "${catalog_file}${backup_file_suffix}" regexp {^.*(packages/.*)$} $test_dir match test_dir_rel set tcl_file "${test_dir_rel}/test-message-tags.tcl" set tcl_backup_file "${tcl_file}${backup_file_suffix}" # The test messages to use for the catalog file 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] # Write the test Tcl file 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" set new_text_2 "text_1_different" set new_key_3 "key_1" set new_text_3 [dict get $messages_array key_1] puts $tcl_file_id "# The following key should be auto-generated and inserted # <# ${new_key_1} ${new_text_1} #> # # The following key should be made unique and inserted # <#${new_key_2} ${new_text_2}#> # # The following key should not be inserted in the message catalog # <#${new_key_3} ${new_text_3}#>" close $tcl_file_id # Write the catalog file lang::catalog::export_to_file $catalog_file $messages_array # We need to force the API to export to the test catalog file aa_stub lang::catalog::get_catalog_file_path " return $catalog_file " # Replace message tags in the Tcl file and insert into catalog file aa_silence_log_entries -severities warning { lang::util::replace_temporary_tags_with_lookups $tcl_file } aa_unstub lang::catalog::get_catalog_file_path # Read the contents of the catalog file set catalog_array [lang::catalog::parse [lang::catalog::read_file $catalog_file]] set updated_messages_array [dict get $catalog_array messages] # Assert that the old messages are unchanged foreach old_message_key [dict keys $messages_array] { aa_equals "old key $old_message_key should be unchanged" \ [dict get $messages_array $old_message_key] \ [dict get $updated_messages_array $old_message_key] } # Check that the first new key was autogenerated aa_equals "check autogenerated key" [dict get $updated_messages_array Auto_Key] $new_text_1 # Check that the second new key was made unique and inserted aa_equals "check key made unique" [dict get $updated_messages_array ${new_key_2}_1] $new_text_2 # Check that the third key was not inserted aa_equals "third key not inserted" \ [expr {[dict exists $updated_messages_array $new_key_3] ? [dict get $updated_messages_array $new_key_3] : ""}] \ [dict get $messages_array $new_key_3] # Check that there are no tags left in the Tcl file set tcl_file_id [open "$::acs::rootdir/$tcl_file" r] set updated_tcl_contents [read $tcl_file_id] close $tcl_file_id aa_equals "tags in Tcl file replaced" \ [llength [lang::util::get_temporary_tags_indices $updated_tcl_contents]] \ 0 # Delete the test message keys foreach message_key [concat [dict keys $messages_array] $expected_new_keys] { lang::message::unregister $package_key $message_key } # Delete the catalog files file delete -- $catalog_backup_file file delete -- $catalog_file # Delete the Tcl files file delete -- $::acs::rootdir/$tcl_file file delete -- $::acs::rootdir/$tcl_backup_file } aa_register_case \ -procs { 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]] aa_true "there should be two hash entries" {[llength $indices_list] == 2} 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" { [lindex $index_item 0] eq [lindex $expected_index_item 0] && [lindex $index_item 1] eq [lindex $expected_index_item 1] } incr counter } } aa_register_case \ -procs { 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) @creation-date 25 October 2002 } { set adp_chunk "<property name=\"title\">@array.variable_name@ @variable_name2;noquote@ peter@collaboraid.biz</property>" set adp_chunk_converted [lang::util::convert_adp_variables_to_percentage_signs $adp_chunk] set adp_chunk_expected "<property name=\"title\">%array.variable_name% %variable_name2;noquote% peter@collaboraid.biz</property>" aa_equals "adp vars should be substituted with percentage sings" $adp_chunk_converted $adp_chunk_expected set adp_chunk_converted_back [lang::util::convert_percentage_signs_to_adp_variables $adp_chunk_converted] aa_equals "after having converted the text with percentage signs back to adp we should have what we started with" $adp_chunk_converted $adp_chunk_expected # Test that a string can start with adp vars set adp_chunk "@first_names.foobar;noquote@ @last_name@ peter@collaboraid.biz" set adp_chunk_converted [lang::util::convert_adp_variables_to_percentage_signs $adp_chunk] set adp_chunk_expected "%first_names.foobar;noquote% %last_name% peter@collaboraid.biz" aa_equals "adp vars should be substituted with percentage sings" $adp_chunk_converted $adp_chunk_expected set adp_chunk_converted_back [lang::util::convert_percentage_signs_to_adp_variables $adp_chunk_converted] aa_equals "after having converted the text with percentage signs back to adp we should have what we started with" $adp_chunk_converted $adp_chunk_expected set percentage_chunk {You are <a href="%role.character_url%">%role.character_title%</a> (%role.role_pretty%)} set percentage_chunk_converted [lang::util::convert_percentage_signs_to_adp_variables $percentage_chunk] set percentage_chunk_expected {You are <a href="@role.character_url@">@role.character_title@</a> (@role.role_pretty@)} aa_equals "converting percentage vars to adp vars" $percentage_chunk_converted $percentage_chunk_expected } aa_register_case \ -procs { lang::test::get_dir lang::util::replace_adp_text_with_message_tags } util__replace_adp_text_with_message_tags { @author Peter Marklund (peter@collaboraid.biz) @creation-date 28 October 2002 } { # File paths used set adp_file_path "[lang::test::get_dir]/adp_tmp_file.adp" # Write the adp test file set adp_file_id [open $adp_file_path w] puts $adp_file_id "<master src=\"master\"> <property name=\"title\">@first_names@ @last_name@ peter@collaboraid.biz</property> <property name=\"context_bar\">@context_bar@</property> Test text" close $adp_file_id # Do the substitutions lang::util::replace_adp_text_with_message_tags $adp_file_path "write" # Read the changed test file set adp_file_id [open $adp_file_path r] set adp_contents [read $adp_file_id] close $adp_file_id set expected_adp_pattern {<master src=\"master\"> <property name=\"title\"><#[a-zA-Z_]+ @first_names@ @last_name@ peter@collaboraid.biz#></property> <property name=\"context_bar\">@context_bar@</property> <#[a-zA-Z_]+ Test text\s*} # Assert proper replacements have been done aa_true "replacing adp text with tags" \ [regexp $expected_adp_pattern $adp_contents match] # Remove the adp test file file delete -- $adp_file_path } aa_register_case \ -procs { lang::message::format } message__format { @author Peter Marklund (peter@collaboraid.biz) @creation-date 21 October 2002 } { set localized_message "The %frog% jumped across the %fence%. About 50% of the time, he stumbled, or maybe it was %%20 %times%." set value_list {frog frog fence fence} aa_silence_log_entries -severities warning { set subst_message [lang::message::format $localized_message $value_list] } set expected_message "The frog jumped across the fence. About 50% of the time, he stumbled, or maybe it was %20 %times%." aa_equals "the frog should jump across the fence" $subst_message $expected_message set my_var(my_key) foo set localized_message "A text with an array variable %my_var.my_key% in it" set subst_message [lang::message::format $localized_message {} 1] set expected_message "A text with an array variable foo in it" aa_equals "embedded array variable" $subst_message $expected_message } aa_register_case \ -procs { lang::message::get_embedded_vars lang::message::embedded_vars_regexp util_get_subset_missing util_sets_equal_p } message__get_embedded_vars { @author Peter Marklund (peter@collaboraid.biz) @creation-date 12 November 2002 } { set en_us_message "This message contains no vars" set new_message "This is a message with some %vars% and some more %variables%" set missing_vars_list [util_get_subset_missing \ [lang::message::get_embedded_vars $new_message] \ [lang::message::get_embedded_vars $en_us_message]] if { ![aa_true "Find missing vars 'vars' and 'variables'" [util_sets_equal_p $missing_vars_list { vars variables }]] } { aa_log "Missing variables returned was: '$missing_vars_list'" aa_log "en_US Message: '$en_us_message' -> Variables: '[lang::message::get_embedded_vars $en_us_message]'" aa_log "Other Message: '$new_message' -> Variables: '[lang::message::get_embedded_vars $new_message]'" } # This failed on the test servers set en_us_message "Back to %ad_url%%return_url%" set new_message "Tillbaka till %ad_url%%return_url%" set missing_vars_list [util_get_subset_missing \ [lang::message::get_embedded_vars $new_message] \ [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" } # Testing variables with digits in the variable names set en_us_message "Some variables %var1%%var2% again" set new_message "Nogle variable %var1%%var2% igen" set missing_vars_list [util_get_subset_missing \ [lang::message::get_embedded_vars $new_message] \ [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 { apm_package_id_from_key lang::system::locale lang::system::locale lang::system::set_locale lang::system::site_wide_locale parameter::set_value parameter::get } 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 # There's no foreign key constraint on the locales column, so this # should work 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 } finally { parameter::set_value \ -parameter UsePackageLevelLocalesP \ -package_id [apm_package_id_from_key "acs-lang"] \ -value $use_package_level_locales_p_org } aa_equals "Retrieved system locale ('$retrieved_locale') equals the one we just set ('$locale_to_set')" \ $locale_to_set \ $retrieved_locale } aa_register_case \ -procs { lang::conn::browser_locale lang::system::locale_set_enabled lang::test::assert_browser_locale } locale__test_lang_conn_browser_locale { @author Peter Marklund @creation-date 2003-08-13 } { aa_run_with_teardown \ -rollback \ -test_code { # The tests assume that the danish locale is enabled lang::system::locale_set_enabled -locale "da_DK" -enabled t # 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 \ -procs { lang::util::default_locale_from_lang } default_locale_from_lang { Check that the retrieval of the default locale for a language is working } { set default_locale [lang::util::default_locale_from_lang en] aa_true "Retrieve the default english locale works fine" {$default_locale eq "en_US"} } aa_register_case \ -procs { lang::conn::timezone lang::system::set_timezone lang::system::timezone lang::user::set_timezone lang::user::timezone lc_list_all_timezones util::random_range } set_get_timezone { Test that setting and getting user timezone works } { # Make sure we have a logged-in user set org_user_id [ad_conn user_id] if { $org_user_id == 0 } { set user_id [db_string user { select min(user_id) from users }] ad_conn -set user_id $user_id } else { set user_id $org_user_id } # Remember originals so we can restore them set system_timezone [lang::system::timezone] set user_timezone [lang::user::timezone] set timezones [lc_list_all_timezones] set n [expr {[llength $timezones]-1}] set desired_user_timezone [lindex $timezones [util::random_range $n] 0] set desired_system_timezone [lindex $timezones [util::random_range $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 lang::user::set_timezone {} aa_equals "Fallback to system timezone when no user pref" \ [lang::conn::timezone] \ $desired_system_timezone } on error {errorMsg} { set error_p 1 # rethrow the error error $errorMsg $::errorInfo } finally { lang::system::set_timezone $system_timezone lang::user::set_timezone $user_timezone ad_conn -set user_id $org_user_id } } aa_register_case \ -procs { lang::conn::timezone lang::system::timezone lang::user::set_timezone } set_timezone_not_logged_in { Test that setting and getting user timezone throws an error when user is not logged in } { set user_id [ad_conn user_id] ad_conn -set user_id 0 aa_equals "Fallback to system timezone when no user" \ [lang::conn::timezone] \ [lang::system::timezone] 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 ad_conn -set user_id $user_id } aa_register_case \ -procs { lang::conn::timezone lc_time_fmt } lc_time_fmt_Z_timezone { lc_time_fmt %Z returns current connection timezone } { aa_equals "%Z returns current timezone" \ [lc_time_fmt "2003-08-15 13:40:00" "%Z"] \ [lang::conn::timezone] } aa_register_case \ -procs { lang::catalog::import lang::message::lookup lang::message::register lang::system::locale_set_enabled } locale_language_fallback { 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 } { # # Check if en_GB is enabled # set enabled_p [nsv_array exists lang_message_en_GB] # # Run the test # aa_run_with_teardown -test_code { # # Enable en_GB if necessary # if { ! $enabled_p } { lang::system::locale_set_enabled \ -locale en_GB \ -enabled_p 1 # # GN: we see several message of the following form # # Warning: Warning: No catalog files found for package acs-tcl in locales: en_GB # # Is this intended? However, it does not effect the # outcome of the regression test. # aa_silence_log_entries -severities warning { lang::catalog::import -locales en_GB } } # # Create messages # 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] # # Test missing en_GB returns en_US message key # ns_log notice 3 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 # # Test existing en_GB returns en_GB message key # ns_log notice 4 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 } -teardown_code { # # Clean up messages # db_dml delete_msg { delete from lang_messages where package_key = :package_key and message_key = :message_key } db_dml delete_key { delete from lang_message_keys where package_key = :package_key and message_key = :message_key } # # Disable en_GB if it was disabled previously # if { ! $enabled_p } { lang::system::locale_set_enabled \ -locale en_GB \ -enabled_p 0 nsv_unset lang_message_en_GB db_dml delete_messages { delete from lang_messages where locale = 'en_GB' } } } } aa_register_case \ -procs { lang::catalog::import lang::message::edit lang::message::get lang::message::unregister lang::system::locale_set_enabled lang::test::execute_upgrade lang::test::setup_test_package lang::test::teardown_test_package aa_silence_log_entries apm_package_info_file_path apm_package_register apm_package_install_version apm_package_install_owners apm_callback_and_log apm_interface_add apm_version_enable apm_package_install apm_package_delete } upgrade { Test that a package can be upgraded with new catalog files and that the resulting keys and messages in the database can then be exported properly. What we are testing is a scenario similar to what we have on the OpenACS Translation server (http://translate.openacs.org). @author Peter Marklund } { # Create the test package in the filesystem lang::test::setup_test_package # Can't run this test case with the usual rollback switch since if everything # is wrapped in one transaction then the creation_date of the messages will be the # same and the query in lang::catalog::last_sync_messages will return duplicates. aa_run_with_teardown \ -test_code { lang::test::execute_upgrade -locale en_US lang::system::locale_set_enabled \ -locale de_DE \ -enabled_p t lang::test::execute_upgrade -locale de_DE } -teardown_code { foreach message_key [array names upgrade_expect] { lang::message::unregister $package_key $message_key } lang::test::teardown_test_package } } aa_register_case -procs { lang::message::register lang::message::unregister lang::util::localize } localize { @author Peter Marklund } { set package_key "acs-lang" set message_key "__test-key" set message "Test message" aa_run_with_teardown \ -rollback \ -test_code { # Create a temporary test message to test with lang::message::register en_US $package_key $message_key $message # Create some random character strings to surround the embedded key set pre_text "a;<ls#;#kdfj'...,mlkjoiu><wgon" set post_text "a;lskd<fj'...,mlkjo>iuwgon#" set message_key_embedded "#${package_key}.${message_key}#" # Test replacements set text1 $message_key_embedded aa_equals "One message key with no surrounding text" \ [lang::util::localize $text1] \ $message set text1 "${pre_text}${message_key_embedded}${post_text}" aa_equals "One message key with surrounding text" \ [lang::util::localize $text1] \ "${pre_text}${message}${post_text}" set text1 "${pre_text}${message_key_embedded}" aa_equals "One message key with text before" \ [lang::util::localize $text1] \ "${pre_text}${message}" set text1 "${message_key_embedded}${post_text}" aa_equals "One message key with text after" \ [lang::util::localize $text1] \ "${message}${post_text}" set text1 "${pre_text}${message_key_embedded}${post_text}${pre_text}${message_key_embedded}${post_text}" aa_equals "Two message keys with surrounding text" \ [lang::util::localize $text1] \ "${pre_text}${message}${post_text}${pre_text}${message}${post_text}" } -teardown_code { # We need to clear the cache lang::message::unregister $package_key $message_key } } aa_register_case \ -procs { lang::message::check } lang_messages_correct { 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 get_message_keys { select message_key, package_key, locale, message from lang_messages where not deleted_p and locale in (select locale from ad_locales where enabled_p) } { set error_p [catch {lang::message::check $locale $package_key $message_key $message} errmsg] set errmsg [expr {$error_p ? ": $errmsg" : ""}] aa_false "Message $message_key in package $package_key for locale $locale correct$errmsg" $error_p } } } aa_register_case \ -procs { lang::catalog::package_has_files_in_locale_p } lang_package_has_files_in_locale_p { Check that this private interface returns the right value when a catalog file for a package is available or not } { set locale en_US foreach package_key {acs-lang acs-kernel acs-subsite} { aa_true "We have message keys for '$package_key'->'$locale'" \ [lang::catalog::package_has_files_in_locale_p $package_key $locale] } set bogus_package_key [ad_generate_random_string] set bogus_locale [ad_generate_random_string] aa_false "We don't have message keys for bogus '$bogus_package_key'->'$locale'" \ [lang::catalog::package_has_files_in_locale_p $bogus_package_key $locale] aa_false "We don't have message keys for bogus '$package_key'->'$bogus_locale'" \ [lang::catalog::package_has_files_in_locale_p $package_key $bogus_locale] aa_false "We don't have message keys for bogus '$bogus_package_key'->'$bogus_locale'" \ [lang::catalog::package_has_files_in_locale_p $bogus_package_key $bogus_locale] } aa_register_case \ -procs { ::lang::catalog::get_catalog_paths_for_import } catalog_files_are_tdom_parsable_xml { Make sure that what is found in catalog files is parsable by tDOM. Note that the files are neither "valid XML" nor "well-formed XML" due to the fact that the "msg" content might contain HTML. } { set catalog_files [list] foreach package_key [db_list get_packages {select distinct package_key from apm_packages}] { lappend catalog_files {*}[lang::catalog::get_catalog_paths_for_import -package_key $package_key] } foreach f $catalog_files { set xml [lang::catalog::read_file $f] aa_false "Catalog file '$f' appears to be valid XML" [catch {dom parse -- $xml doc}] } } ad_proc -private lang::test::get_all_package_files {} { Get all files on the system where some message key is expected. } { set files [list] set directories [list $::acs::rootdir/packages/] while {[llength $directories] > 0} { set d [lindex $directories 0] set directories [lrange $directories 1 end] lappend directories {*}[glob -directory $d -nocomplain -types d *] lappend files {*}[glob -directory $d -nocomplain -types {f r} *.{adp,sql,tcl}] } return $files } aa_register_case \ -error_level warning \ lang_message_dependencies_are_fine { Makes sure that message key usages are consistent with the package dependencies. } { # # Some packages define 'install' packages in their info files, # that will be also installed, but that are not a dependency # in a technical sense. For the purposes of this test, we will # treat them as normal dependencies. # db_foreach get_packages { select distinct i.package_key, a.attribute_value as install from apm_package_version_info i, apm_package_version_attr a where a.version_id = i.version_id and a.attribute_name = 'install' and i.enabled_p = 't' } { foreach i $install { lappend installed($package_key) \ $i {*}[apm_package_load_libraries_order $i] set installed($package_key) [lsort -unique $installed($package_key)] } } # Retrieve dependencies for every package known to the system foreach package_key [db_list get_packages { select distinct i.package_key, a.attribute_value as installed from apm_package_version_info i left join apm_package_version_attr a on a.version_id = i.version_id and a.attribute_name = 'install' where i.enabled_p = 't' }] { set dependencies($package_key) {} foreach pk [apm_package_load_libraries_order $package_key] { # # 'Real' dependency # lappend dependencies($package_key) $pk if {[info exists installed($pk)]} { # # Dependencies derived by packages that are # installed by one of my dependencies. # lappend dependencies($package_key) {*}$installed($pk) } } set dependencies($package_key) [lsort -unique $dependencies($package_key)] } # Create a lookup array for every message key on the system to # tell a real message key from rubbish db_foreach get_messages { select package_key, message_key from lang_messages } { set message_keys(${package_key}.${message_key}) 1 } # A theme package might override message keys from various # packages, while not depending on any of them, we do not # check for those occurrences. set theme_folders [db_list get_theme_folders { select resource_dir from subsite_themes where resource_dir is not null }] # Get "all files" on the system... set root_prefix [string length $::acs::rootdir/packages/] set theme_regexp ^([join $theme_folders |]).*$ foreach f [lang::test::get_all_package_files] { set package_key [lindex [file split [string range $f $root_prefix end]] 0] if {![info exists dependencies($package_key)]} { #aa_log "'$f' does not belong to a package installed on the system." continue } if {[regexp $theme_regexp [string range $f [string length $::acs::rootdir] end]]} { aa_log "'$f' is a theme file and can refer to any message key." continue } if {[file extension $f] in {.sql}} { continue } elseif {[file extension $f] in {.adp .html .htm}} { set RE [lang::util::message_key_regexp] } else { set RE {[-a-zA-Z0-9_]+\.[-a-zA-Z0-9_]+} } set rfd [open $f r] set content [read $rfd] close $rfd # ...parse every possible message key occurrence... foreach occurrence [regexp -all -inline -- $RE $content] { lassign [split [string trim $occurrence "#"] .] message_package_key message_key #ns_log notice [file extension $f] occurrence '$occurrence' \ message_package_key $message_package_key \ message_key $message_key # ...make sure it is a real message key... if {![info exists message_keys(${message_package_key}.${message_key})]} { #ns_log warning "$f: '${message_package_key}.${message_key}' is not a message key." continue } # ..leave the core out of this: its message keys can always be used... if {[string match acs-* $message_package_key]} { aa_log "'${message_package_key}.${message_key}' belongs to the core and can always be used." continue } # ...and check that the package it belongs to is one # of our dependencies. aa_true \ "'$f': message key #${message_package_key}.${message_key}# belongs to dependencies of '$package_key'." \ {$message_package_key in $dependencies($package_key)} } } } aa_register_case -cats { smoke production_safe } -procs { util::which } acs_lang_exec_dependencies { Test external command dependencies for this package. } { foreach cmd [list \ [::util::which find] \ ] { aa_true "'$cmd' is executable" [file executable $cmd] } } # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: