Author: mjevans
Date: Tue Dec 8 03:36:09 2009
New Revision: 13653
Modified:
dbi/trunk/t/90sql_type_cast.t
Log:
Some tests cannot be performed with PurePerl e.g., DiscardString (skipped)
and number overflows do not work the same (don't overflow).
Modified: dbi/trunk/t/90sql_type_cast.t
==============================================================================
--- dbi/trunk/t/90sql_type_cast.t (original)
+++ dbi/trunk/t/90sql_type_cast.t Tue Dec 8 03:36:09 2009
@@ -8,6 +8,7 @@
my $jx = eval {require JSON::XS;};
my $dp = eval {require Data::Peek;};
+my $pp = $DBI::PurePerl && $DBI::PurePerl; # doubled to avoid typo warning
# NOTE: would have liked to use DBI::neat to test the cast value is what
# we expect but unfortunately neat uses SvNIOK(sv) so anything that looks
@@ -36,21 +37,9 @@
SQL_INTEGER, 0, CAST_OK, q{["2147483647"]}],
['4 byte max unsigned int cast to int', "4294967295",
SQL_INTEGER, 0, CAST_OK, q{["4294967295"]}],
- ['very large int cast to int',
- '99999999999999999999', SQL_INTEGER, 0, NO_CAST_NO_STRICT,
- q{["99999999999999999999"]}],
- ['very large int cast to int (strict)',
- '99999999999999999999', SQL_INTEGER, DBIstcf_STRICT,
- NO_CAST_STRICT, q{["99999999999999999999"]}],
['small int cast to int (discard)',
'99', SQL_INTEGER, DBIstcf_DISCARD_STRING, CAST_OK, q{[99]}],
- ['float cast to int', '99.99', SQL_INTEGER, 0,
- NO_CAST_NO_STRICT, q{["99.99"]}],
- ['float cast to int', '99.99', SQL_INTEGER, DBIstcf_STRICT,
- NO_CAST_STRICT, q{["99.99"]}],
- ['float cast to double', '99.99', SQL_DOUBLE, 0, CAST_OK,
- q{["99.99"]}],
['non numeric cast to double', 'aabb', SQL_DOUBLE, 0,
NO_CAST_NO_STRICT, q{["aabb"]}],
['non numeric cast to double (strict)', 'aabb', SQL_DOUBLE,
@@ -62,19 +51,38 @@
DBIstcf_STRICT, NO_CAST_STRICT, q{["aa"]}],
);
-if ($Config{ivsize} == 4) {
+if (!$pp) {
+ # some tests cannot be performed with PurePerl as numbers don't
+ # overflow in the same way as XS.
push @tests,
- ['4 byte max unsigned int cast to int (ivsize=4)', "4294967296",
- SQL_INTEGER, 0, NO_CAST_NO_STRICT, q{["4294967296"]}];
-} elsif ($Config{ivsize} >= 8) {
- push @tests,
- ['4 byte max unsigned int cast to int (ivsize>8)', "4294967296",
- SQL_INTEGER, 0, CAST_OK, q{["4294967296"]}];
+ (
+ ['very large int cast to int',
+ '99999999999999999999', SQL_INTEGER, 0, NO_CAST_NO_STRICT,
+ q{["99999999999999999999"]}],
+ ['very large int cast to int (strict)',
+ '99999999999999999999', SQL_INTEGER, DBIstcf_STRICT,
+ NO_CAST_STRICT, q{["99999999999999999999"]}],
+ ['float cast to int', '99.99', SQL_INTEGER, 0,
+ NO_CAST_NO_STRICT, q{["99.99"]}],
+ ['float cast to int (strict)', '99.99', SQL_INTEGER,
DBIstcf_STRICT,
+ NO_CAST_STRICT, q{["99.99"]}],
+ ['float cast to double', '99.99', SQL_DOUBLE, 0, CAST_OK,
+ q{["99.99"]}]
+ );
+ if ($Config{ivsize} == 4) {
+ push @tests,
+ ['4 byte max unsigned int cast to int (ivsize=4)', "4294967296",
+ SQL_INTEGER, 0, NO_CAST_NO_STRICT, q{["4294967296"]}];
+ } elsif ($Config{ivsize} >= 8) {
+ push @tests,
+ ['4 byte max unsigned int cast to int (ivsize>8)', "4294967296",
+ SQL_INTEGER, 0, CAST_OK, q{["4294967296"]}];
+ }
}
+
my $tests = @tests;
$tests *= 2 if $jx;
-$tests++; # for use_ok
foreach (@tests) {
$tests++ if ($dp) && ($_->[3] & DBIstcf_DISCARD_STRING);
$tests++ if ($dp) && ($_->[2] == SQL_DOUBLE);
@@ -82,10 +90,6 @@
plan tests => $tests;
-BEGIN {
- use_ok('DBI');
-}
-
foreach my $test(@tests) {
my $val = $test->[1];
#diag(join(",", map {neat($_)} Data::Peek::DDual($val)));
@@ -96,18 +100,28 @@
}
is($result, $test->[4], "result, $test->[0]");
if ($jx) {
- my $json = JSON::XS->new->encode([$val]);
- #diag(neat($val), ",", $json);
- is($json, $test->[5], "json $test->[0]");
+
+ SKIP: {
+ skip 'DiscardString not supported in PurePerl', 1
+ if $pp && ($test->[3] & DBIstcf_DISCARD_STRING);
+
+ my $json = JSON::XS->new->encode([$val]);
+ #diag(neat($val), ",", $json);
+ is($json, $test->[5], "json $test->[0]");
+ };
}
-
+
my ($pv, $iv, $nv, $rv, $hm);
($pv, $iv, $nv, $rv, $hm) = Data::Peek::DDual($val) if $dp;
if ($dp && ($test->[3] & DBIstcf_DISCARD_STRING)) {
#diag("D::P ",neat($pv), ",", neat($iv), ",", neat($nv),
# ",", neat($rv));
- ok(!defined($pv), "discard works, $test->[0]") if $dp;
+ SKIP: {
+ skip 'DiscardString not supported in PurePerl', 1 if $pp;
+
+ ok(!defined($pv), "discard works, $test->[0]") if $dp;
+ };
}
if (($test->[2] == SQL_DOUBLE) && ($dp)) {
#diag("D::P ", neat($pv), ",", neat($iv), ",", neat($nv),
@@ -119,3 +133,5 @@
}
}
}
+
+1;
