The odbc driver segfaults when I try to pass a null inout parameter (the
last test in the script), personally this is not something I need so I
don't really care if it gets fixed, but as far as I can see it's a bug in
the odbc interface, so it really ought to get fixed.
The stacktrace is:
Program received signal SIGSEGV, Segmentation fault.
0x400d6303 in memcpy () from /lib/libc.so.6
(gdb) where
#0 0x400d6303 in memcpy () from /lib/libc.so.6
#1 0x402368b2 in aptnm2ch (in_string_ptr=0xbfffed0c ' ' <repeats 38
times>, "31", in_format=3, out_string_ptr=0x0, out_length=100,
out_scale=0,
out_format=12, used=0xbfffee70) at vpa04tc.c:304
#2 0x40235bee in apfnumeric (in_ptr=0x81ed270 ' ' <repeats 38 times>,
"31", in_length=41, in_scale=0, moved_len_ptr=0x81ec4dc, in_format=3,
out_ptr=0x0, out_length=100, out_format=1, numericScale=0,
used=0xbfffee70) at vpa04fc.c:1130
#3 0x402331fc in apgstoc (sql_type=3, sql_ptr=0x81ed270 ' ' <repeats 38
times>, "31", sql_len=41, sql_scale=0, moved_len_ptr=0x81ec4dc, fCtype=1,
numericScale=0, c_ptr=0x0, c_len=100, c_used_ptr=0xbfffefa8) at
vpa04gc.c:328
#4 0x402344cf in apgetoc (esq_type=0, esq_ptr=0x81ed270 ' ' <repeats 38
times>, "31", esq_len=41, esq_scale=0, moved_len_ptr=0x81ec4dc, fCtype=1,
numericScale=0, c_ptr=0x0, c_len=100, c_used_ptr=0xbfffefa8) at
vpa04gc.c:183
#5 0x4025654f in pa20SMap (impl_desc_ptr=0x81e6f40, icol=1,
dbc_special_ptr=0x81e6da8, c_type=1, numericScale=0, c_data_ptr=0x0,
c_data_max_len=100, c_data_used_ptr=0xbfffefa8) at vpa20Desc.c:3494
#6 0x4025560f in pa20Move (appl_desc_ptr=0x81e6fc0,
impl_desc_ptr=0x81e6f40, number_cols=1, special_dbc_ptr=0x81e6da8) at
vpa20Desc.c:2410
#7 0x4024045d in paSQLExecute (hstmt=136211856) at vpa10ec.c:1027
#8 0x40240eee in SQLExecute (hstmt=136211856) at vpa10ec.c:830
#9 0x4022e681 in odbc_st_execute () from
/usr/lib/perl5/site_perl/5.6.0/i586-linux/auto/DBD/ODBC/ODBC.so
#10 0x4022a199 in XS_DBD__ODBC__st_execute () from
/usr/lib/perl5/site_perl/5.6.0/i586-linux/auto/DBD/ODBC/ODBC.so
#11 0x401c9a83 in XS_DBI_dispatch () from
/usr/lib/perl5/site_perl/5.6.0/i586-linux/auto/DBI/DBI.so
#12 0x809b7ed in Perl_pp_entersub ()
#13 0x8096380 in Perl_runops_standard ()
#14 0x805c0b5 in S_run_body ()
#15 0x805be1e in perl_run ()
#16 0x8059982 in main ()
#17 0x40077c6f in __libc_start_main () from /lib/libc.so.6
--
Regards Flemming Frandsen aka. Dion/Swamp http://dion.swamp.dk
#!/usr/bin/perl -w
use strict;
use DBI;
my ($sid,$user,$passwd) = ('ZDB','TEST','TEST');
print STDERR <<'EOS';
sapdbtest (c) 2001 by Flemming Frandsen <[EMAIL PROTECTED]>
This is free software licensed under the GNU General Public License (GPL)
EOS
# My little helper function, call with:
# The DBI database handle, The SQL code and the parameters.
# It will then return the result of the execute (or $sth if it's a dataset).
sub sql {
my $db = shift;
my $code = shift;
my @param = @_;
chomp $code; # No good reason to have a tailing \n
my $sth = $db->prepare_cached($code);
if (!$sth) {
print "Unable to prepare: ".$DBI::errstr."\nSQL: $code\n";
return undef;
}
# Bind the parameters:
for (my $i=0;$i<@param;$i++) {
my $p = $param[$i];
if (ref($p)) {
$sth->bind_param_inout($i+1,$p,100);
} else {
$sth->bind_param($i+1,$p);
}
}
my $res = $sth->execute;
if (!$res) {
my $par = join(',', map( defined($_)?$_:'undef', @param));
print "Unable to execute: ".$DBI::errstr."\nSQL: $code\nPAR: $par\n";
return undef;
}
if (ref($res) eq 'ARRAY') {
return $res;
} else {
return $sth;
}
}
print STDERR "Connecting (to $sid as $user/$passwd)...";
my $db = DBI->connect("dbi:ODBC:$sid", $user, $passwd,
{
AutoCommit=>0,
LongReadLen=>10000,
}
);
unless ($db) {
die "Failed to connect to the database $sid as user $user with password $passwd:
".$DBI::errstr;
}
print STDERR "Done.\n";
print STDERR "Creating stuff...";
sql($db,<<'EOQ') or die "Unable to create table a";
CREATE TABLE a (
id INT NOT NULL,
nullable_field INT,
notnullable_field INT NOT NULL,
default_field INT DEFAULT 42,
string_field VARCHAR(40),
PRIMARY KEY(id)
)
EOQ
sql($db,<<'EOQ') or die "Unable to create sequence";
CREATE SEQUENCE ids
INCREMENT BY 1
START WITH 1
EOQ
print STDERR "Done.\n";
print STDERR "Testing sequence and output parameters...";
for (my $i=1;$i<=30;$i++) {
my $id=-1;
sql($db,<<'EOQ',\$id) or die "Unable to fetch value from sequence";
SELECT ids.NEXTVAL INTO ? FROM dual
EOQ
if ($id < $i) {
die "fetched id: $id is not the same as the expected id: $i";
}
print STDERR "$id,";
}
print STDERR "Done.\n";
print STDERR "Testing insert/select and input parameters...";
my $lastid = 424242;
sql($db,<<'EOQ', $lastid, undef, 37, "Hello world $lastid" ) or die "Unable to insert
data with inputparameters";
INSERT INTO a (id, nullable_field, notnullable_field, string_field)
VALUES (?, ?, ?, ?)
EOQ
my $res = sql($db,<<'EOQ', $lastid ) or die "Unable to fetch data with input
parameters";
SELECT id, nullable_field, notnullable_field, default_field, string_field
FROM a
WHERE id = ?
EOQ
my ($id, $nullable_field, $notnullable_field, $default_field, $string_field) =
$res->fetchrow_array or die "Unable to find the inserted row";
$res->finish;
if ($id != $lastid) {die "fetched id ($id) is not the same as the inserted
id ($lastid)"; }
if (defined $nullable_field) {die "fetched nullable_field is not undef (aka null), it
was $nullable_field"; }
if ($notnullable_field != 37) {die "fetched notnullable_field was not 37, it was
$notnullable_field"; }
if ($default_field != 42) {die "fetched default_field was not 42, it was:
$default_field"; }
if ($string_field ne "Hello world $lastid") {die "fetched string_field was not
correct, it was: $string_field"; }
print STDERR "Done.\n";
print STDERR "Testing invalid prepare...";
$db->prepare("select garbage from garbage") and die "invalid query could be prepared";
print STDERR "Done\n";
print STDERR "Testing ping...";
$db->ping or die "ping doesn't work";
print STDERR "Done\n";
print STDERR "Testing undef inout...";
my $hmm=undef;
sql($db,<<'EOQ',\$hmm) or die "Unable to fetch value from sequence, with a null inout
parameter";
SELECT ids.NEXTVAL INTO ? FROM dual
EOQ
print STDERR "Done\n";
$db->rollback;
$db->disconnect;
print "All tests passed\n";
