_acs-tcl__files__page_contracts (private)

 _acs-tcl__files__page_contracts

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

Partial Call Graph (max 5 caller/called nodes):
%3 aa_log aa_log (public) aa_log_result aa_log_result (public) ad_file ad_file (public) apm_get_installed_versions apm_get_installed_versions (public) apm_get_package_files apm_get_package_files (public) _acs-tcl__files__page_contracts _acs-tcl__files__page_contracts _acs-tcl__files__page_contracts->aa_log _acs-tcl__files__page_contracts->aa_log_result _acs-tcl__files__page_contracts->ad_file _acs-tcl__files__page_contracts->apm_get_installed_versions _acs-tcl__files__page_contracts->apm_get_package_files

Testcases:
No testcase defined.
Source code:
        
        set _aa_export {}
        set body_count 1
        foreach testcase_body {{
    # if startdir is not $::acs::rootdir/packages, then somebody checked in the wrong thing by accident
    set startdir $::acs::rootdir/packages

    aa_log "Checks starting from $startdir"

    # get tcl files from installed packages
    set files [list]
    apm_get_installed_versions -array installed_versions
    foreach {package_key version} [array get installed_versions] {
        lappend files {*}[lmap f [apm_get_package_files  -package_key $package_key  -file_types {content_page include_page}] {
            # Ignore non .tcl files, doc, and common NaviServer modules
            if {[ad_file extension $f] ne ".tcl"
                || "$package_key" eq "acs-core-docs"
                || [ad_file tail $f] eq "nsstats.tcl"
            } continue
            set f $startdir/$package_key/$f
        }]
    }

    #inspect every Tcl file in the directory tree starting with $startdir
    set count 0
    set good 0
    foreach file $files {
        set f [open $file "r"]
        incr count
        set contract_found_p false
        #ns_log notice "Looking for contracts in file $file"
        while {[gets $f line] >= 0 && !$contract_found_p} {
            # '::xowiki::Package initialize -ad_doc' idioms are not
            # that easy to identify, as nothing prevents from writing
            # them on multiple lines or using different flags... This
            # simple pattern matching is based on occurrences as found
            # in upstream code.
            set patterns [list "::xowiki::Package initialize -ad_doc" "ad_page_contract" "ad_include_contract"]
            if {[regexp [join $patterns |] $line]} {
                # Found contract!
                incr good
                set contract_found_p true
            }
        }
        close $f

        # Check results on $file
        if { !$contract_found_p } {
            aa_log_result fail "$file: no 'ad_page_contract', 'ad_include_contract', or '::xowiki::Package initialize -ad_doc' found"
        }
    }
    aa_log "$good of $count tcl files checked have 'ad_page_contract', 'ad_include_contract' or ::xowiki::Package initialize -ad_doc"
}} {
          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" "files__page_contracts (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: