Subject: | bugfix - sig-abort on nested objects with ora_objects=1 |
I found bug in ora_objects.
I fixed this bug, patch is attached.
I added also test for nested objects into t/58object.t (included in patch)
Subject: | ora-nested-objects-svn-patch.diff |
Index: oci8.c
===================================================================
--- oci8.c (revision 12798)
+++ oci8.c (working copy)
@@ -1792,6 +1792,7 @@
fbh_obj_t *fld;
OCIInd *obj_ind;
fbh_obj_t *obj = base_obj;
+ OCIType *tdo = obj->tdo;
if (DBIS->debug >= 5 || dbd_verbose >= 5 ) {
PerlIO_printf(DBILOGFP, " getting attributes of object named %s with typecode=%s\n",obj->type_name,oci_typecode_name(obj->typecode));
@@ -1805,7 +1806,6 @@
OCIRef *type_ref=0;
sword status;
- OCIType *tdo;
status = OCIObjectNew(fbh->imp_sth->envhp, fbh->imp_sth->errhp, fbh->imp_sth->svchp,
OCI_TYPECODE_REF, (OCIType *)0,
@@ -1816,7 +1816,7 @@
return 0;
}
- status=OCIObjectGetTypeRef(fbh->imp_sth->envhp,fbh->imp_sth->errhp, (dvoid*)fbh->obj->obj_value, type_ref);
+ status=OCIObjectGetTypeRef(fbh->imp_sth->envhp,fbh->imp_sth->errhp, (dvoid*)value, type_ref);
if (status != OCI_SUCCESS) {
oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectGetTypeRef");
return 0;
@@ -1837,7 +1837,7 @@
if (tdo != obj->tdo) {
/* new subtyped -> get obj description */
if (DBIS->debug >= 5 || dbd_verbose >= 5 ) {
- PerlIO_printf(DBILOGFP, " describe subtype of object type %s\n",base_obj->type_name);
+ PerlIO_printf(DBILOGFP, " describe subtype (tdo=%x) of object type %s (tdo=%x)\n",(int)tdo,base_obj->type_name,(int)base_obj->tdo);
}
Newz(1, obj->next_subtype, 1, fbh_obj_t);
@@ -1907,7 +1907,7 @@
}
status = OCIObjectGetAttr(fbh->imp_sth->envhp, fbh->imp_sth->errhp, value,
- obj_ind, obj->tdo,
+ obj_ind, tdo,
(CONST oratext**)&fld->type_name, &fld->type_namel, 1,
(ub4 *)0, 0, &attr_null_status, &attr_null_struct,
&attr_value, &attr_tdo);
@@ -1929,7 +1929,7 @@
get_object (sth,fld->fields[0].value, fbh, &fld->fields[0],attr_value);
av_push(list, new_ora_object(fld->fields[0].value, fld->typecode));
- } else{ /* else, display the scaler type attribute */
+ } else{ /* else, display the scalar type attribute */
get_attr_val(sth,list, fbh, fld->type_name, fld->typecode, attr_value);
Index: t/58object.t
===================================================================
--- t/58object.t (revision 12798)
+++ t/58object.t (working copy)
@@ -5,7 +5,7 @@
use strict;
use Data::Dumper;
-use Test::More tests => 35;
+use Test::More tests => 46;
unshift @INC ,'t';
require 'nchar_test_lib.pl';
@@ -45,10 +45,12 @@
my $obj_prefix = "dbd_test_";
my $super_type = "${obj_prefix}_type_A";
my $sub_type = "${obj_prefix}_type_B";
+my $complex_type = "${obj_prefix}_type_C";
my $table = "${obj_prefix}_obj_table";
sub drop_test_objects {
- for my $obj ("TABLE $table", "TYPE $sub_type", "TYPE $super_type") {
+ for my $obj ("TABLE $table", "TYPE $sub_type", "TYPE $super_type",
+ "TYPE $complex_type") {
#do not warn if already there
eval {
local $dbh->{PrintError} = 0;
@@ -68,6 +70,10 @@
datetime DATE,
amount NUMERIC(10,5)
) NOT FINAL }) or die $dbh->errstr;
+$dbh->do(qq{ CREATE OR REPLACE TYPE $complex_type AS OBJECT (
+ obj1 $super_type,
+ obj2 $super_type
+ )}) or die $dbh->errstr;
$dbh->do(qq{ CREATE TABLE $table (id INTEGER, obj $super_type) })
or die $dbh->errstr;
$dbh->do(qq{ INSERT INTO $table VALUES (1, $super_type(13, 'obj1')) })
@@ -152,6 +158,31 @@
is_deeply($obj->attr, $expected_hash, 'DBD::Oracle::Object->attr');
is($obj->attr("NAME"), 'obj3', 'DBD::Oracle::Object->attr("NAME")');
+# Test nested objects
+$sth = $dbh->prepare("select new $complex_type($super_type(1, 'AB'), $sub_type(2,'X', TO_DATE('2009-06-01', 'YYYY-MM-DD'), 3.3)) FROM dual");
+ok ($sth, 'nested objects: Prepare select');
+ok ($sth->execute(), 'nested objects: Execute select');
+
+@row1 = $sth->fetchrow();
+is (scalar @row1, 1, 'nested objects: 1 column fetched');
+
+$obj = $row1[0];
+isa_ok($obj, 'DBD::Oracle::Object', 'nested objects: complex_object ISA ok');
+is($obj->type_name, uc "$schema.$complex_type", 'nested objects: complex_object type ok');
+
+isa_ok($obj->attr('OBJ1'), 'DBD::Oracle::Object', 'nested objects: complex_object->obj1 ISA ok');
+isa_ok($obj->attr('OBJ2'), 'DBD::Oracle::Object', 'nested objects: complex_object->obj2 ISA ok');
+
+is($obj->attr('OBJ1')->type_name, uc "$schema.$super_type", 'nested objects: complex_object->obj1->type_name ok');
+is($obj->attr('OBJ2')->type_name, uc "$schema.$sub_type", 'nested objects: complex_object->obj2->type_name ok');
+
+is_deeply([$obj->attr('OBJ1')->attributes], ['NUM', 1, 'NAME', 'AB'],
+ 'nested objects: complex_object->obj1->attributes ok');
+is_deeply([$obj->attr('OBJ2')->attributes], ['NUM', 2, 'NAME', 'X', 'DATETIME', '2009-06-01T00:00:00', 'AMOUNT', 3.3],
+ 'nested objects: complex_object->obj2->attributes ok');
+
+$sth->finish();
+
#cleanup
&drop_test_objects;
$dbh->disconnect;