_acs-lang__lang_message_dependencies_are_fine (private)

 _acs-lang__lang_message_dependencies_are_fine

Defined in packages/acs-lang/tcl/test/acs-lang-test-procs.tcl

Partial Call Graph (max 5 caller/called nodes):
%3 aa_log aa_log (public) aa_log_result aa_log_result (public) aa_true aa_true (public) apm_package_load_libraries_order apm_package_load_libraries_order (public) db_foreach db_foreach (public) _acs-lang__lang_message_dependencies_are_fine _acs-lang__lang_message_dependencies_are_fine _acs-lang__lang_message_dependencies_are_fine->aa_log _acs-lang__lang_message_dependencies_are_fine->aa_log_result _acs-lang__lang_message_dependencies_are_fine->aa_true _acs-lang__lang_message_dependencies_are_fine->apm_package_load_libraries_order _acs-lang__lang_message_dependencies_are_fine->db_foreach

Testcases:
No testcase defined.
Source code:
        
        set _aa_export {}
        set body_count 1
        foreach testcase_body {{
        #
        # 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_log "Running testcase body $body_count"
          set ::__aa_test_indent [info level]
          set catch_val [catch $testcase_body msg]
          if {$catch_val != 0 && $catch_val != 2} {
              aa_log_result "fail" "lang_message_dependencies_are_fine (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo"
          }
          incr body_count
        }
XQL Not present:
Generic, PostgreSQL, Oracle
[ hide source ] | [ make this the default ]
Show another procedure: