• Publicity: Public Only All

xotcl-test-procs.tcl

Test xotcl-core features

Location:
packages/xotcl-core/tcl/test/xotcl-test-procs.tcl

Procedures in this file

Detailed information

_xotcl-core__test_cr_items (private)

 _xotcl-core__test_cr_items

Partial Call Graph (max 5 caller/called nodes):
%3 aa_equals aa_equals (public) aa_log aa_log (public) aa_log_result aa_log_result (public) aa_run_with_teardown aa_run_with_teardown (public) aa_section aa_section (public) _xotcl-core__test_cr_items _xotcl-core__test_cr_items _xotcl-core__test_cr_items->aa_equals _xotcl-core__test_cr_items->aa_log _xotcl-core__test_cr_items->aa_log_result _xotcl-core__test_cr_items->aa_run_with_teardown _xotcl-core__test_cr_items->aa_section

Testcases:
No testcase defined.

_xotcl-core__test_db_out_of_pools (private)

 _xotcl-core__test_db_out_of_pools

Partial Call Graph (max 5 caller/called nodes):
%3 aa_false aa_false (public) aa_log aa_log (public) aa_log_result aa_log_result (public) db_available_pools db_available_pools (public) _xotcl-core__test_db_out_of_pools _xotcl-core__test_db_out_of_pools _xotcl-core__test_db_out_of_pools->aa_false _xotcl-core__test_db_out_of_pools->aa_log _xotcl-core__test_db_out_of_pools->aa_log_result _xotcl-core__test_db_out_of_pools->db_available_pools

Testcases:
No testcase defined.

_xotcl-core__test_misc_core (private)

 _xotcl-core__test_misc_core

Partial Call Graph (max 5 caller/called nodes):
%3 aa_equals aa_equals (public) aa_log aa_log (public) aa_log_result aa_log_result (public) aa_true aa_true (public) xo::db::list_to_values xo::db::list_to_values (public) _xotcl-core__test_misc_core _xotcl-core__test_misc_core _xotcl-core__test_misc_core->aa_equals _xotcl-core__test_misc_core->aa_log _xotcl-core__test_misc_core->aa_log_result _xotcl-core__test_misc_core->aa_true _xotcl-core__test_misc_core->xo::db::list_to_values

Testcases:
No testcase defined.

_xotcl-core__test_multirow (private)

 _xotcl-core__test_multirow

Partial Call Graph (max 5 caller/called nodes):
%3 aa_equals aa_equals (public) aa_log aa_log (public) aa_log_result aa_log_result (public) aa_section aa_section (public) ad_conn ad_conn (public) _xotcl-core__test_multirow _xotcl-core__test_multirow _xotcl-core__test_multirow->aa_equals _xotcl-core__test_multirow->aa_log _xotcl-core__test_multirow->aa_log_result _xotcl-core__test_multirow->aa_section _xotcl-core__test_multirow->ad_conn

Testcases:
No testcase defined.

_xotcl-core__test_prepared_statements (private)

 _xotcl-core__test_prepared_statements

Partial Call Graph (max 5 caller/called nodes):
%3 aa_equals aa_equals (public) aa_false aa_false (public) aa_log aa_log (public) aa_log_result aa_log_result (public) template::multirow template::multirow (public) _xotcl-core__test_prepared_statements _xotcl-core__test_prepared_statements _xotcl-core__test_prepared_statements->aa_equals _xotcl-core__test_prepared_statements->aa_false _xotcl-core__test_prepared_statements->aa_log _xotcl-core__test_prepared_statements->aa_log_result _xotcl-core__test_prepared_statements->template::multirow

Testcases:
No testcase defined.

_xotcl-core__test_xo_db_object (private)

 _xotcl-core__test_xo_db_object

Partial Call Graph (max 5 caller/called nodes):
%3 aa_equals aa_equals (public) aa_log aa_log (public) aa_log_result aa_log_result (public) aa_run_with_teardown aa_run_with_teardown (public) aa_section aa_section (public) _xotcl-core__test_xo_db_object _xotcl-core__test_xo_db_object _xotcl-core__test_xo_db_object->aa_equals _xotcl-core__test_xo_db_object->aa_log _xotcl-core__test_xo_db_object->aa_log_result _xotcl-core__test_xo_db_object->aa_run_with_teardown _xotcl-core__test_xo_db_object->aa_section

Testcases:
No testcase defined.
[ hide source ] | [ make this the default ]

Content File Source

ad_library {
    Test xotcl-core features
}

aa_register_case -cats {
    api smoke
} -procs {
    "::xo::db::Class proc exists_in_db"
    "::xo::db::Class proc get_instance_from_db"
    "::xo::db::DB-postgresql instproc get_value"

    "::xo::db::select_driver"
    "::xo::db::Object instproc save"
    "::xo::db::Object instproc save_new"
    "::xo::db::Object instproc delete"
    "::xo::db::Class proc object_type_to_class"
    "::xo::db::DB-postgresql instproc 0or1row"
    "::xo::db::DB-postgresql instproc 1row"
    "::xo::db::DB instproc transaction"
    "::xo::db::Object instproc update"
    "::xo::db::CrClass proc get_object_type"
    "::throttle proc check"

} test_xo_db_object {
   Test basic ::xo::db::Object ORM features
} {
    aa_run_with_teardown -test_code {

        aa_section "Quick trivial CRUD of an object"
        aa_log "Create object"
        set orm_object [::xo::db::Object new]
        aa_log "Save new"
        set object_id [$orm_object save_new]
        $orm_object destroy

        aa_log "Fetch"
        set orm_object [::xo::db::Class get_instance_from_db -id $object_id]
        aa_log "Save"
        $orm_object save
        aa_log "Delete"
        $orm_object delete
        #$orm_object destroy

        aa_section "Object creation"
        aa_log "Create object"
        set orm_object [::xo::db::Object new]
        $orm_object set title "test_title"
        set object_id [$orm_object save_new]

        aa_log "Destroy object"
        $orm_object destroy

        set orm_exists_p [::xo::db::Class exists_in_db -id $object_id]
        set db_exists_p [::xo::dc 0or1row lookup_object {
            select 1 from acs_objects where object_id = :object_id
        }]
        aa_true "Object was created" {$orm_exists_p && $db_exists_p}


        aa_section "Object fetching"
        aa_log "Fetching object from ORM"
        set orm_object [::xo::db::Class get_instance_from_db -id $object_id]
        aa_log "Fetching object from DB"
        ::xo::dc 1row get_object_from_db {
            select title as object_title,
                   creation_date,
                   creation_user,
                   creation_ip,
                   package_id,
                   context_id,
                   modifying_user,
                   modifying_ip,
                   last_modified
            from acs_objects
            where object_id = :object_id
        }
        set attributes {
            object_title
            creation_date
            creation_user
            creation_ip
            package_id
            context_id
            modifying_user
            modifying_ip
            last_modified
        }
        foreach att $attributes {
            aa_equals "Same $att" [set $att] [$orm_object set $att]
        }


        aa_section "Object manipulation"
        aa_log "Setting a different title"
        set new_title "a different title"
        $orm_object set object_title $new_title

        set old_context_id [$orm_object set context_id]
        # obtain a random different context_id
        set new_context_id [::xo::dc get_value get_context_id {
            select min(object_id) from acs_objects
            where object_id <> :object_id
              and (:old_context_id is null or object_id <> :old_context_id)
        }]
        aa_log "Setting a different context_id: $new_context_id"
        $orm_object set context_id $new_context_id

        aa_log "Saving the object $orm_object"
        $orm_object save


        aa_log "Fetching object attributes from DB"
        ::xo::dc 1row get_object_from_db {
            select title as object_title,
                   creation_date,
                   creation_user,
                   creation_ip,
                   package_id,
                   context_id,
                   modifying_user,
                   modifying_ip,
                   last_modified
            from acs_objects
            where object_id = :object_id
        }


        aa_section "Check modifications BEFORE refetching"
        aa_equals "title was updated"      [$orm_object set object_title] $new_title
        aa_equals "context_id was updated" [$orm_object set context_id]   $new_context_id
        foreach att $attributes {
            if {![aa_equals "Attribute $att in the object matches database value" [set $att] [$orm_object set $att]]} {
                aa_log "DB: [set $att]| ORM: [$orm_object set $att]"
            }
        }


        aa_section "Check modifications AFTER refetching"
        aa_log "Fetching object again from ORM"
        set orm_object [::xo::db::Class get_instance_from_db -id $object_id]
        aa_equals "title was updated"      [$orm_object set object_title] $new_title
        aa_equals "context_id was updated" [$orm_object set context_id]   $new_context_id
        foreach att $attributes {
            if {![aa_equals "Attribute $att in the object matches database value" [set $att] [$orm_object set $att]]} {
                aa_log "DB: [set $att]| ORM: [$orm_object set $att]"
            }
        }


        aa_section "Object deletion"
        $orm_object delete
        set orm_exists_p [::xo::db::Class exists_in_db -id $object_id]
        set db_exists_p [::xo::dc 0or1row lookup_object {
            select 1 from acs_objects where object_id = :object_id
        }]
        aa_true "Object is not there anymore" {!$orm_exists_p && !$db_exists_p}

    }
}

aa_register_case -cats {
    api smoke
} -procs {
    "::xo::db::Class proc exists_in_db"
    "::xo::db::CrClass instproc get_instance_from_db"
    "::xo::db::CrClass proc get_instance_from_db"
    "::xo::db::DB-postgresql instproc get_value"

    "::cr_check_mime_type"
    "::cr_create_content_file"
    "::xo::db::Class proc object_type_to_class"
    "::xo::db::CrItem instproc delete"
    "::xo::db::CrItem instproc save"
    "::xo::db::CrItem instproc save_new"
    "::xo::db::DB instproc transaction"
    "::xo::db::DB-postgresql instproc 0or1row"
    "::xo::db::DB-postgresql instproc 1row"
    "::xo::db::DB-postgresql instproc dml"
    "::xo::db::DB-postgresql instproc insert-view-operation"
    "::xo::db::DB-postgresql instproc row_lock"
    "::xo::db::postgresql instproc nextval"
    "::xo::db::CrClass proc get_object_type"
    "::throttle proc check"
} test_cr_items {
   Test basic ::xo::db::CrItem ORM features
} {
    aa_run_with_teardown -test_code {

        aa_section "Quick trivial CRUD of an object"
        aa_log "Create object"
        set orm_object [::xo::db::CrItem new]

        aa_log "Save new"
        set object_id [$orm_object save_new]
        $orm_object destroy

        aa_log "Fetch"
        set orm_object [::xo::db::CrClass get_instance_from_db -item_id $object_id]
        aa_log "Save"
        $orm_object save

        aa_log "Delete"
        $orm_object delete
        $orm_object destroy

        aa_section "Object creation"
        aa_log "Create object"
        set orm_object [::xo::db::CrItem new]
        $orm_object set title "test_title"
        set object_id [$orm_object save_new]
        set revision_id [$orm_object set revision_id]

        aa_log "Destroy object"
        $orm_object destroy

        set orm_exists_p [::xo::db::Class exists_in_db -id $object_id]
        set db_exists_p [::xo::dc 0or1row lookup_object {
            select 1 from cr_items where item_id = :object_id
        }]
        aa_true "Object was created" {$orm_exists_p && $db_exists_p}

        aa_section "Object fetching"
        aa_log "Fetching object from ORM"
        set orm_object [::xo::db::CrClass get_instance_from_db -item_id $object_id]
        aa_log "Fetching object from DB ($orm_object)"
        ::xo::dc 1row get_object_from_db {
            select creation_date,
                   creation_user,
                   creation_ip,
                   modifying_ip,
                   package_id,
                   context_id
            from acs_objects
            where object_id = :object_id
        }
        # In CrItem some modification info is in fact creation info of
        # the live revision
        ::xo::dc 1row get_revision_object {
            select creation_user as modifying_user,
                   creation_date as last_modified
            from acs_objects
            where object_id = :revision_id
        }
        set title [::xo::dc get_value get_title {
            select title from cr_revisions
            where revision_id = :revision_id
        }]
        set attributes {
            title
            creation_date
            creation_user
            creation_ip
            package_id
            context_id
            modifying_user
            modifying_ip
            last_modified
        }
        foreach att $attributes {
            if {![aa_equals "Attribute $att in the object matches database value" [set $att] [$orm_object set $att]]} {
                aa_log "DB: [set $att]| ORM: [$orm_object set $att]"
            }
        }


        aa_section "Object manipulation"
        aa_log "Setting a different title"
        set new_title "a different title"
        $orm_object set title $new_title

        set old_context_id [$orm_object set context_id]
        # obtain a random different context_id
        set new_context_id [::xo::dc get_value get_context_id {
            select min(object_id) from acs_objects
            where object_id <> :object_id
              and (:old_context_id is null or object_id <> :old_context_id)
        }]
        aa_log "Setting a different context_id: $new_context_id"
        $orm_object set context_id $new_context_id

        aa_log "Saving the object"
        set old_revision_id [$orm_object set revision_id]
        $orm_object save
        set revision_id [$orm_object set revision_id]

        aa_true "revision_id changed after saving" {$revision_id != $old_revision_id}
        aa_true "Old revision is still there" [::xo::dc 0or1row check_old_revision {
            select 1 from cr_revisions where revision_id = :old_revision_id
        }]
        aa_true "New revision is the live revision" {
            $revision_id == [::xo::dc get_value get_live_revision {
                select live_revision from cr_items
                where item_id = :object_id
            }]
        }

        aa_log "Fetching object again from DB"
        ::xo::dc 1row get_object_from_db {
            select creation_date,
                   creation_user,
                   creation_ip,
                   modifying_ip,
                   package_id,
                   context_id
            from acs_objects
            where object_id = :object_id
        }
        # In CrItem some modification info is in fact creation info of
        # the live revision
        ::xo::dc 1row get_revision_object {
            select creation_user as modifying_user,
                   creation_date as last_modified
            from acs_objects
            where object_id = :revision_id
        }
        set title [::xo::dc get_value get_title {
            select title from cr_revisions
            where revision_id = :revision_id
        }]


        aa_section "Check modifications BEFORE refetching"
        aa_equals "title was updated"      [$orm_object set title]      $new_title
        aa_equals "context_id was updated" [$orm_object set context_id] $new_context_id
        foreach att $attributes {
            if {![aa_equals "Attribute $att in the object matches database value" [set $att] [$orm_object set $att]]} {
                aa_log "DB: [set $att]| ORM: [$orm_object set $att]"
            }
        }

        aa_section "Check modifications AFTER refetching"
        aa_log "Fetching object again from ORM"
        set orm_object [::xo::db::CrItem get_instance_from_db -item_id $object_id]
        aa_equals "title was updated"      [$orm_object set title]      $new_title
        aa_equals "context_id was updated" [$orm_object set context_id] $new_context_id
        foreach att $attributes {
            if {![aa_equals "Attribute $att in the object matches database value" [set $att] [$orm_object set $att]]} {
                aa_log "DB: [set $att]| ORM: [$orm_object set $att]"
            }
        }

        aa_section "Object deletion"
        $orm_object delete
        set orm_exists_p [::xo::db::Class exists_in_db -id $object_id]
        set db_exists_p [::xo::dc 0or1row lookup_object {
            select 1 from acs_objects where object_id = :object_id
        }]
        aa_true "Object is not there anymore" {!$orm_exists_p && !$db_exists_p}

    }
}

aa_register_case -cats {
    api smoke
} -procs {
    "::xo::require_html_procs"
    "::xo::db::list_to_values"
    "::xo::db::tcl_date"
} test_misc_core {
    Test various small xotcl-core functionalities.
} {
    ::xo::require_html_procs
    aa_true "html::a exists" {[info commands ::html::a] ne ""}

    aa_equals "xo::db::list_to_values" [xo::db::list_to_values {1 2 3}] {(VALUES ('1'),('2'),('3'))}

    aa_equals "tcl_date from oracle" [::xo::db::tcl_date 2008-08-25 tz_var secfrac_var] 2008-08-25
    aa_equals "tcl_date from oracle TZ and secfrac" "$tz_var $secfrac_var" "00 0"

    aa_equals "tcl_date from PostgreSQL type ANSI format secfrac and TZ" \
        [::xo::db::tcl_date "2017-08-08 13:19:33.264032+02" tz_var secfrac_var] "2017-08-08 13:19:33"
    aa_equals "tcl_date from PostgreSQL TZ and secfrac" "$tz_var $secfrac_var" "+02 264032"

    aa_equals "tcl_date from PostgreSQL type ANSI format secfrac no TC" \
        [::xo::db::tcl_date "2017-08-08 13:19:33.264032" tz_var secfrac_var] "2017-08-08 13:19:33"
    aa_equals "tcl_date from PostgreSQL TZ and secfrac" "$tz_var $secfrac_var" "00 264032"

    aa_equals "tcl_date from PostgreSQL type ANSI format no TC" \
        [::xo::db::tcl_date "2017-08-08 13:19:33" tz_var secfrac_var] "2017-08-08 13:19:33"
    aa_equals "tcl_date from PostgreSQL TZ and secfrac" "$tz_var $secfrac_var" "00 0"
}

aa_register_case -cats {
    api smoke
} -procs {
    "::xo::dc get_value"
    "::xo::dc 1row"
    "::xo::dc foreach"
    "::xo::dc multirow"
} test_prepared_statements {
    Tests the ::xo::dc with respect to prepared statements.
} {
    #
    # get_value
    #

    aa_false "::xo::dc get_value with 0 parameters, unprepared statement - no error" [catch {
        set object_id [::xo::dc get_value one_object {select max(object_id) from acs_objects}]
    }]

    aa_false "::xo::dc get_value with 0 parameters, prepared statement - no error" [catch {
        set object_id [::xo::dc get_value -prepare "" one_object {
            select max(object_id) from acs_objects
        }]
    }]

    #
    # 1row
    #

    aa_false "::xo::dc 1row with 1 parameter, unprepared statement - no error" [catch {
        ::xo::dc 1row get_object {
            select object_id as object_id_found_1
            from acs_objects where object_id = :object_id
        }
    }]

    aa_equals "::xo::dc 1row with 1 parameter, unprepared statement - value was returned" \
        $object_id $object_id_found_1

    aa_false "::xo::dc 1row with 1 parameter, prepared statement" [catch {
        ::xo::dc 1row -prepare integer get_object {
            select object_id as object_id_found_2
            from acs_objects where object_id = :object_id
        }
    }]

    aa_equals "::xo::dc 1row with 1 parameter, prepared statement - value was returned" \
        $object_id $object_id_found_2

    aa_false "::xo::dc 1row with 2 parameters, unprepared statement - no error" [catch {
        ::xo::dc 1row get_object {
            select object_id as object_id_found_3
            from acs_objects where object_id = :object_id and object_id = :object_id
        }
    }]

    aa_equals "::xo::dc 1row with 2 parameters, unprepared statement - value was returned" \
        $object_id $object_id_found_3

    aa_false "::xo::dc 1row with 2 parameters, prepared statement" [catch {
        ::xo::dc 1row -prepare integer,integer get_object {
            select object_id as object_id_found_4
            from acs_objects where object_id = :object_id and object_id = :object_id
        }
    }]

    if {[info procs ns_pg_prepare] ne ""} {

        #
        # ns_pg_prepare is implemented via tcl fallback: this
        # NaviServer version will not support prepared statements
        # where the query contains strings with colon.
        #
        set aa_error_level $::aa_error_level
        set ::aa_error_level warning
        aa_log_result fail "This NaviServer version does not support prepared statements with strings containing colons."
        set ::aa_error_level $aa_error_level

    } else {

        aa_false "::xo::dc 1row with 1 parameter, prepared statement with SQL containing colon - no error" [catch {
            ::xo::dc 1row -prepare integer get_object {
                select object_id as object_id_found_6
                from acs_objects where object_id = :object_id and title <> '__I:Do:Not:Exist'
            }
        }]

        aa_equals "::xo::dc 1row with 1 parameter, prepared statement with SQL containing colon - value was returned" \
            $object_id $object_id_found_6

        aa_false "::xo::dc 1row with 1 parameter, prepared statement with SQL containing colon - no error" [catch {
            ::xo::dc 1row -prepare integer get_object {
                select object_id as object_id_found_7
                from acs_objects
                where object_id = :object_id
                and title <> ':__I:Do:Not:Exist'
                and title <> ' :__I::also:Do:Not:Exist'
            }
        }]

        aa_equals "::xo::dc 1row with 1 parameter, prepared statement with SQL containing colon - value was returned" \
            $object_id $object_id_found_7

    }

    #
    # foreach
    #

    aa_false "::xo::dc foreach with 1 parameter - no error" [catch {
        set l [list]
        ::xo::dc foreach get_object {
            select object_id as object_id_found_8
            from acs_objects
           where object_id = :object_id
        } {
            lappend l $object_id_found_8
        }
    }]

    aa_equals "::xo::dc foreach with 1 parameter - value was returned" \
        $l [list $object_id]

    aa_false "::xo::dc foreach with 1 parameter, prepared statement - no error" [catch {
        set l2 [list]
        ::xo::dc foreach -prepare integer get_object {
            select object_id as object_id_found_9
            from acs_objects
           where object_id = :object_id
        } {
            lappend l2 $object_id_found_9
        }
    }]

    aa_equals "::xo::dc foreach with 1 parameter, prepared statement - value was returned" \
        $l2 [list $object_id]

    #
    # multirow
    #

    aa_false "::xo::dc multirow with 1 parameter - no error" [catch {
        set l3 [list]
        ::xo::dc multirow test get_object {
            select object_id as object_id_found_10
            from acs_objects
           where object_id = :object_id
        } {
            lappend l3 $object_id_found_10
        }
    }]

    aa_equals "::xo::dc multirow with 1 parameter - value was returned" \
        $l3 [list $object_id]

    aa_false "::xo::dc multirow with 1 parameter, prepared statement - no error" [catch {
        ::xo::dc multirow -prepare integer test get_object {
            select object_id + 1 as object_id_found_10
            from acs_objects
           where object_id = :object_id
        } {
            lappend l3 $object_id_found_10
        }
    }]

    aa_equals "::xo::dc multirow with 1 parameter, prepared statement - value was returned" \
        $l3 [list $object_id [expr {$object_id + 1}]]

    aa_equals "::xo::dc multirow appended twice to the test multirow" \
        [::template::multirow size test] 2

}

aa_register_case -cats {
    api smoke
} -procs {
    "::xo::dc multirow"
} test_multirow {
    Tests the ::xo::dc multirow api
} {
    aa_section "Test that ::xo::dc multirow behaves as db_multirow with respect to Bug 3441"
    #
    # Create a multirow with 0 entries and append a row "manually"
    # For details, see # https://openacs.org/bugtracker/openacs/bug?bug_number=3441
    #
    ::xo::dc multirow __xotcl_person_mr1 noxql {
        SELECT person_id, first_names, last_name
        FROM persons WHERE false
    }

    aa_equals "have empty multirow" [template::multirow size __xotcl_person_mr1] 0
    template::multirow append __xotcl_person_mr1 1234 “Ed” “Grooberman”
    aa_equals "have one tuple in multirow" [template::multirow size __xotcl_person_mr1] 1

    aa_equals "columns empty" \
        [template::multirow columns __xotcl_person_mr1] \
        "person_id first_names last_name"

    set user_id [ad_conn user_id]
    ::xo::dc multirow person_mr2 noxql {
        SELECT person_id, first_names, last_name
        FROM persons where person_id = :user_id
    }
    aa_equals "columns nonempty" \
        [template::multirow columns person_mr2] \
        "person_id first_names last_name"

    aa_section "Create a new multirow via ::xo::dc, then append via the ::template api"

    # We set d outside the multirow body to show that the variable
    # will be reinitialized at every loop.
    set d a

    ::xo::dc multirow -local t -extend {d e} __test_multirow q {
        select *
        from (values (1, 2, 3), (4, 5, 6), (7, 8, 9), (10, 11, 12), (666, 666, 666)) as t (a, b, c)
    } {
        # Test issuing continue in the loop
        if {$a == 7} {
            continue
        }

        # Test issuing break in the loop
        if {$c == 12} {
            break
        }

        # Test changing a "native" column
        incr a

        # Test changing an extended column (var existed outside)
        append d a
    }

    aa_equals "columns nonempty" \
        [template::multirow -local columns __test_multirow] \
        {a b c d e}

    aa_equals "size is 2" [template::multirow -local size __test_multirow] 2

    set template {
        <ul>
        <multiple name="__test_multirow">
        <li>
        |@__test_multirow.a@|
        @__test_multirow.b@|
        @__test_multirow.c@|
        @__test_multirow.d@|
        @__test_multirow.e@
        </li>
        </multiple>
        </ul>
    }

    set code [template::adp_compile -string $template]

    set expected {
        <ul>
        <li>|2|2|3|a|</li>
        <li>|5|5|6|a|</li>
        </ul>
    }

    aa_equals "Template returns expected result" \
        [join [template::adp_eval code] ""] [join $expected ""]

    template::multirow -local append __test_multirow I am appended to multirow

    set expected {
        <ul>
        <li>|2|2|3|a|</li>
        <li>|5|5|6|a|</li>
        <li>|I|am|appended|to|multirow</li>
        </ul>
    }

    aa_equals "Template returns expected result after appending to the multirow" \
        [join [template::adp_eval code] ""] [join $expected ""]


    aa_section "Create a multirow via the ::template api, then append via the ::xo::dc interface"
    template::multirow -local create __test_multirow_2 a b c
    template::multirow -local append __test_multirow_2 1 2 3

    ::xo::dc multirow -local t __test_multirow_2 q {
        select *
        from (values (4, 5, 6), (7, 8, 9)) as t (a, b, c)
    }

    aa_equals "size is 3" [template::multirow -local size __test_multirow_2] 3

    aa_section "Append again via ::xo::dc"

    ::xo::dc multirow -extend {b c} -local t __test_multirow_2 q {
        select *
        from (values (10), (13)) as t (a)
    } {
        set b [expr {$a + 1}]
        set c [expr {$b + 1}]
    }

    aa_equals "size is 5" [template::multirow -local size __test_multirow_2] 5

    set template {
        <ul>
        <multiple name="__test_multirow_2">
        <li>
        |@__test_multirow_2.a@|
        @__test_multirow_2.b@|
        @__test_multirow_2.c@|
        </li>
        </multiple>
        </ul>
    }

    set code [template::adp_compile -string $template]

    set expected {
        <ul>
        <li>|1|2|3|</li>
        <li>|4|5|6|</li>
        <li>|7|8|9|</li>
        <li>|10|11|12|</li>
        <li>|13|14|15|</li>
        </ul>
    }

    aa_equals "Template returns expected result after appending to the multirow" \
        [join [template::adp_eval code] ""] [join $expected ""]

    aa_section "Multirows with a numeric value ending in '.'"

    ::xo::dc multirow -local t __test_multirow_dot_1 q {
        select *
        from (values ('2.')) as t(a)
    }
    ::template::multirow -local foreach __test_multirow_dot_1 {
        aa_equals "Value is correct when looping through __test_multirow_dot_1 later" $a "2."
    }

    ::xo::dc multirow -local t __test_multirow_dot_2 q {
        select *
        from (values ('2.')) as t(a)
    } {
        aa_equals "Value is correct in __test_multirow_dot_2 body" $a "2."
    }
    ::template::multirow -local foreach __test_multirow_dot_2 {
        aa_equals "Value is correct when looping through __test_multirow_dot_2 later" $a "2."
    }

}

aa_register_case -cats {
    api smoke
} -procs {
    "::xo::dc foreach"
    "::xo::dc multirow"
} test_db_out_of_pools {

    Makes sure the ::xo::dc api does not incur in the "out of pools"
    bug when nested looping idioms are executed.

} {
    set one_too_many_pools [expr {[llength [db_available_pools ""]] + 1}]

    aa_false "Nesting $one_too_many_pools '::xo::dc foreach' does not return an error" [catch {
        set code {}
        for {set i 0} {$i < $one_too_many_pools} {incr i} {
            set code "::xo::dc foreach q {select 1 from dual} {$code}"
        }
        eval $code
    }]

    aa_false "Nesting $one_too_many_pools '::xo::dc multirow' does not return an error" [catch {
        set code {}
        for {set i 0} {$i < $one_too_many_pools} {incr i} {
            set code "::xo::dc multirow test_$i q {select 1 from dual} {$code}"
        }
        eval $code
    }]

}

# Local variables:
#    mode: tcl
#    tcl-indent-level: 4
#    indent-tabs-mode: nil
# End: