_xotcl-core__test_xo_db_object (private)

 _xotcl-core__test_xo_db_object

Defined in packages/xotcl-core/tcl/test/xotcl-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_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]
        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

        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 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_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" "test_xo_db_object (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo"
          }
          incr body_count
        }

XQL Not present:

Generic, PostgreSQL, Oracle