_acs-tcl__ad_proc_create_callback (private)

 _acs-tcl__ad_proc_create_callback

Defined in packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl

Partial Call Graph (max 5 caller/called nodes):

Testcases:

No testcase defined.

Source code:

        
        set _aa_export {}
        set body_count 1
        foreach testcase_body {{
    aa_true "throw error for ad_proc -callback with extraneous proc body"  [catch {
            d_proc -callback a_callback { arg1 arg2 } { docs } { body }
        } error]

    aa_true "throw error for callback called contract"  [catch {
            d_proc -callback contract { arg1 arg2 } { docs } -
        } error]

    aa_silence_log_entries -severities warning {
        #
        # In this situation, [info script] returns empty, and no
        # package_key can be determined
        #
        #     Warning: cannot determine package key from script ''
        #
        d_proc -callback a_callback { -arg1 arg2 } { this is a test callback } -
    }

    set callback_procs [info commands ::callback::a_callback::*]
    aa_true "creation of a valid callback contract with '-' body"  {"::callback::a_callback::contract" in $callback_procs}

    aa_silence_log_entries -severities warning {
        #
        # In this situation, [info script] returns empty, and no
        # package_key can be determined
        #
        #     Warning: cannot determine package key from script ''
        #
        d_proc -callback a_callback_2 { arg1 arg2 } { this is a test callback } {}
    }
    set callback_procs [info commands ::callback::a_callback_2::*]
    aa_true "creation of a valid callback contract with no body"  {"::callback::a_callback_2::contract" in $callback_procs}

    aa_true "throw error for missing -callback on implementation definition"  [catch {
            d_proc -impl an_impl {} { docs } { body }
        } error]

    aa_true "throw error for implementation named impl"  [catch {
            d_proc -callback a_callback -impl impl {} { docs } { body }
        } error]

    aa_silence_log_entries -severities warning {
        #
        # In this situation, [info script] returns empty, and no
        # package_key can be determined
        #
        #     Warning: cannot determine package key from script ''
        #
        d_proc -callback a_callback -impl an_impl {} {
            this is a test callback implementation
        } {
        }
    }

    set impl_procs [info commands ::callback::a_callback::impl::*]

    aa_true "creation of a valid callback implementation"  {"::callback::a_callback::impl::an_impl" in $impl_procs}
}} {
          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" "ad_proc_create_callback (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo"
          }
          incr body_count
        }

XQL Not present:

Generic, PostgreSQL, Oracle