diff options
Diffstat (limited to 't/01basics.t')
| -rwxr-xr-x | t/01basics.t | 336 |
1 files changed, 336 insertions, 0 deletions
diff --git a/t/01basics.t b/t/01basics.t new file mode 100755 index 0000000..2c11f3c --- /dev/null +++ b/t/01basics.t @@ -0,0 +1,336 @@ +#!perl -w + +use strict; + +use Test::More tests => 130; +use File::Spec; + +$|=1; + +## ---------------------------------------------------------------------------- +## 01basic.t - test of some basic DBI functions +## ---------------------------------------------------------------------------- +# Mostly this script takes care of testing the items exported by the 3 +# tags below (in this order): +# - :sql_types +# - :squl_cursor_types +# - :util +# It also then handles some other class methods and functions of DBI, such +# as the following: +# - $DBI::dbi_debug & its relation to DBI->trace +# - DBI->internal +# and then tests on that return value: +# - $i->debug +# - $i->{DebugDispatch} +# - $i->{Warn} +# - $i->{Attribution} +# - $i->{Version} +# - $i->{private_test1} +# - $i->{cachedKids} +# - $i->{Kids} +# - $i->{ActiveKids} +# - $i->{Active} +# - and finally that it will not autovivify +# - DBI->available_drivers +# - DBI->installed_versions (only for developers) +## ---------------------------------------------------------------------------- + +## load DBI and export some symbols +BEGIN { + use_ok('DBI', qw( + :sql_types + :sql_cursor_types + :utils + )); +} + +## ---------------------------------------------------------------------------- +## testing the :sql_types exports + +cmp_ok(SQL_GUID , '==', -11, '... testing sql_type'); +cmp_ok(SQL_WLONGVARCHAR , '==', -10, '... testing sql_type'); +cmp_ok(SQL_WVARCHAR , '==', -9, '... testing sql_type'); +cmp_ok(SQL_WCHAR , '==', -8, '... testing sql_type'); +cmp_ok(SQL_BIT , '==', -7, '... testing sql_type'); +cmp_ok(SQL_TINYINT , '==', -6, '... testing sql_type'); +cmp_ok(SQL_BIGINT , '==', -5, '... testing sql_type'); +cmp_ok(SQL_LONGVARBINARY , '==', -4, '... testing sql_type'); +cmp_ok(SQL_VARBINARY , '==', -3, '... testing sql_type'); +cmp_ok(SQL_BINARY , '==', -2, '... testing sql_type'); +cmp_ok(SQL_LONGVARCHAR , '==', -1, '... testing sql_type'); +cmp_ok(SQL_UNKNOWN_TYPE , '==', 0, '... testing sql_type'); +cmp_ok(SQL_ALL_TYPES , '==', 0, '... testing sql_type'); +cmp_ok(SQL_CHAR , '==', 1, '... testing sql_type'); +cmp_ok(SQL_NUMERIC , '==', 2, '... testing sql_type'); +cmp_ok(SQL_DECIMAL , '==', 3, '... testing sql_type'); +cmp_ok(SQL_INTEGER , '==', 4, '... testing sql_type'); +cmp_ok(SQL_SMALLINT , '==', 5, '... testing sql_type'); +cmp_ok(SQL_FLOAT , '==', 6, '... testing sql_type'); +cmp_ok(SQL_REAL , '==', 7, '... testing sql_type'); +cmp_ok(SQL_DOUBLE , '==', 8, '... testing sql_type'); +cmp_ok(SQL_DATETIME , '==', 9, '... testing sql_type'); +cmp_ok(SQL_DATE , '==', 9, '... testing sql_type'); +cmp_ok(SQL_INTERVAL , '==', 10, '... testing sql_type'); +cmp_ok(SQL_TIME , '==', 10, '... testing sql_type'); +cmp_ok(SQL_TIMESTAMP , '==', 11, '... testing sql_type'); +cmp_ok(SQL_VARCHAR , '==', 12, '... testing sql_type'); +cmp_ok(SQL_BOOLEAN , '==', 16, '... testing sql_type'); +cmp_ok(SQL_UDT , '==', 17, '... testing sql_type'); +cmp_ok(SQL_UDT_LOCATOR , '==', 18, '... testing sql_type'); +cmp_ok(SQL_ROW , '==', 19, '... testing sql_type'); +cmp_ok(SQL_REF , '==', 20, '... testing sql_type'); +cmp_ok(SQL_BLOB , '==', 30, '... testing sql_type'); +cmp_ok(SQL_BLOB_LOCATOR , '==', 31, '... testing sql_type'); +cmp_ok(SQL_CLOB , '==', 40, '... testing sql_type'); +cmp_ok(SQL_CLOB_LOCATOR , '==', 41, '... testing sql_type'); +cmp_ok(SQL_ARRAY , '==', 50, '... testing sql_type'); +cmp_ok(SQL_ARRAY_LOCATOR , '==', 51, '... testing sql_type'); +cmp_ok(SQL_MULTISET , '==', 55, '... testing sql_type'); +cmp_ok(SQL_MULTISET_LOCATOR , '==', 56, '... testing sql_type'); +cmp_ok(SQL_TYPE_DATE , '==', 91, '... testing sql_type'); +cmp_ok(SQL_TYPE_TIME , '==', 92, '... testing sql_type'); +cmp_ok(SQL_TYPE_TIMESTAMP , '==', 93, '... testing sql_type'); +cmp_ok(SQL_TYPE_TIME_WITH_TIMEZONE , '==', 94, '... testing sql_type'); +cmp_ok(SQL_TYPE_TIMESTAMP_WITH_TIMEZONE , '==', 95, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_YEAR , '==', 101, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_MONTH , '==', 102, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_DAY , '==', 103, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_HOUR , '==', 104, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_MINUTE , '==', 105, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_SECOND , '==', 106, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_YEAR_TO_MONTH , '==', 107, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_DAY_TO_HOUR , '==', 108, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_DAY_TO_MINUTE , '==', 109, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_DAY_TO_SECOND , '==', 110, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_HOUR_TO_MINUTE , '==', 111, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_HOUR_TO_SECOND , '==', 112, '... testing sql_type'); +cmp_ok(SQL_INTERVAL_MINUTE_TO_SECOND , '==', 113, '... testing sql_type'); + +## ---------------------------------------------------------------------------- +## testing the :sql_cursor_types exports + +cmp_ok(SQL_CURSOR_FORWARD_ONLY, '==', 0, '... testing sql_cursor_types'); +cmp_ok(SQL_CURSOR_KEYSET_DRIVEN, '==', 1, '... testing sql_cursor_types'); +cmp_ok(SQL_CURSOR_DYNAMIC, '==', 2, '... testing sql_cursor_types'); +cmp_ok(SQL_CURSOR_STATIC, '==', 3, '... testing sql_cursor_types'); +cmp_ok(SQL_CURSOR_TYPE_DEFAULT, '==', 0, '... testing sql_cursor_types'); + +## ---------------------------------------------------------------------------- +## test the :util exports + +## testing looks_like_number + +my @is_num = looks_like_number(undef, "", "foo", 1, ".", 2, "2"); + +ok(!defined $is_num[0], '... looks_like_number : undef -> undef'); +ok(!defined $is_num[1], '... looks_like_number : "" -> undef (eg "don\'t know")'); +ok( defined $is_num[2], '... looks_like_number : "foo" -> defined false'); +ok( !$is_num[2], '... looks_like_number : "foo" -> defined false'); +ok( $is_num[3], '... looks_like_number : 1 -> true'); +ok( !$is_num[4], '... looks_like_number : "." -> false'); +ok( $is_num[5], '... looks_like_number : 1 -> true'); +ok( $is_num[6], '... looks_like_number : 1 -> true'); + +## testing neat + +cmp_ok($DBI::neat_maxlen, '==', 1000, "... $DBI::neat_maxlen initial state is 400"); + +is(neat(1 + 1), "2", '... neat : 1 + 1 -> "2"'); +is(neat("2"), "'2'", '... neat : 2 -> "\'2\'"'); +is(neat(undef), "undef", '... neat : undef -> "undef"'); + +## testing neat_list + +is(neat_list([ 1 + 1, "2", undef, "foobarbaz"], 8, "|"), "2|'2'|undef|'foo...'", '... test array argument w/seperator and maxlen'); +is(neat_list([ 1 + 1, "2", undef, "foobarbaz"]), "2, '2', undef, 'foobarbaz'", '... test array argument w/out seperator or maxlen'); + + +## ---------------------------------------------------------------------------- +## testing DBI functions + +## test DBI->internal + +my $switch = DBI->internal; + +isa_ok($switch, 'DBI::dr'); + +## checking attributes of $switch + +# NOTE: +# check too see if this covers all the attributes or not + +# TO DO: +# these three can be improved +$switch->debug(0); +pass('... test debug'); +$switch->{DebugDispatch} = 0; # handled by Switch +pass('... test DebugDispatch'); +$switch->{Warn} = 1; # handled by DBI core +pass('... test Warn'); + +like($switch->{'Attribution'}, qr/DBI.*? by Tim Bunce/, '... this should say Tim Bunce'); + +# is this being presumptious? +is($switch->{'Version'}, $DBI::VERSION, '... the version should match DBI version'); + +cmp_ok(($switch->{private_test1} = 1), '==', 1, '... this should work and return 1'); +cmp_ok($switch->{private_test1}, '==', 1, '... this should equal 1'); + +is($switch->{CachedKids}, undef, '... CachedKids should be undef initially'); +my $cache = {}; +$switch->{CachedKids} = $cache; +is($switch->{CachedKids}, $cache, '... CachedKids should be our ref'); + +cmp_ok($switch->{Kids}, '==', 0, '... this should be zero'); +cmp_ok($switch->{ActiveKids}, '==', 0, '... this should be zero'); + +ok($switch->{Active}, '... Active flag is true'); + +# test attribute warnings +{ + my $warn = ""; + local $SIG{__WARN__} = sub { $warn .= "@_" }; + $switch->{FooBarUnknown} = 1; + like($warn, qr/Can't set.*FooBarUnknown/, '... we should get a warning here'); + + $warn = ""; + $_ = $switch->{BarFooUnknown}; + like($warn, qr/Can't get.*BarFooUnknown/, '... we should get a warning here'); + + $warn = ""; + my $dummy = $switch->{$_} for qw(private_foo dbd_foo dbi_foo); # special cases + cmp_ok($warn, 'eq', "", '... we should get no warnings here'); +} + +# is this here for a reason? Are we testing anything? + +$switch->trace_msg("Test \$h->trace_msg text.\n", 1); +DBI->trace_msg("Test DBI->trace_msg text.\n", 1); + +## testing DBI->available_drivers + +my @drivers = DBI->available_drivers(); +cmp_ok(scalar(@drivers), '>', 0, '... we at least have one driver installed'); + +# NOTE: +# we lowercase the interpolated @drivers array +# so that our reg-exp will match on VMS & Win32 + +like(lc("@drivers"), qr/examplep/, '... we should at least have ExampleP installed'); + +# call available_drivers in scalar context + +my $num_drivers = DBI->available_drivers; +cmp_ok($num_drivers, '>', 0, '... we should at least have one driver'); + +## testing DBI::hash + +cmp_ok(DBI::hash("foo1" ), '==', -1077531989, '... should be -1077531989'); +cmp_ok(DBI::hash("foo1",0), '==', -1077531989, '... should be -1077531989'); +cmp_ok(DBI::hash("foo2",0), '==', -1077531990, '... should be -1077531990'); +SKIP: { + skip("Math::BigInt < 1.56",2) + if $DBI::PurePerl && !eval { require Math::BigInt; require_version Math::BigInt 1.56 }; + skip("Math::BigInt $Math::BigInt::VERSION broken",2) + if $DBI::PurePerl && $Math::BigInt::VERSION =~ /^1\.8[45]/; + my $bigint_vers = $Math::BigInt::VERSION || ""; + if (!$DBI::PurePerl) { + cmp_ok(DBI::hash("foo1",1), '==', -1263462440); + cmp_ok(DBI::hash("foo2",1), '==', -1263462437); + } + else { + # for PurePerl we use Math::BigInt but that's often caused test failures that + # aren't DBI's fault. So we just warn (via a skip) if it's not working right. + skip("Seems like your Math::BigInt $Math::BigInt::VERSION has a bug",2) + unless (DBI::hash("foo1X",1) == -1263462440) && (DBI::hash("foo2",1) == -1263462437); + ok(1, "Math::BigInt $Math::BigInt::VERSION worked okay"); + ok(1); + } +} + +is(data_string_desc(""), "UTF8 off, ASCII, 0 characters 0 bytes"); +is(data_string_desc(42), "UTF8 off, ASCII, 2 characters 2 bytes"); +is(data_string_desc("foo"), "UTF8 off, ASCII, 3 characters 3 bytes"); +is(data_string_desc(undef), "UTF8 off, undef"); +is(data_string_desc("bar\x{263a}"), "UTF8 on, non-ASCII, 4 characters 6 bytes"); +is(data_string_desc("\xEA"), "UTF8 off, non-ASCII, 1 characters 1 bytes"); + +is(data_string_diff( "", ""), ""); +is(data_string_diff( "",undef), "String b is undef, string a has 0 characters"); +is(data_string_diff(undef,undef), ""); +is(data_string_diff("aaa","aaa"), ""); + +is(data_string_diff("aaa","aba"), "Strings differ at index 1: a[1]=a, b[1]=b"); +is(data_string_diff("aba","aaa"), "Strings differ at index 1: a[1]=b, b[1]=a"); +is(data_string_diff("aa" ,"aaa"), "String a truncated after 2 characters"); +is(data_string_diff("aaa","aa" ), "String b truncated after 2 characters"); + +is(data_diff( "", ""), ""); +is(data_diff(undef,undef), ""); +is(data_diff("aaa","aaa"), ""); + +is(data_diff( "",undef), + join "","a: UTF8 off, ASCII, 0 characters 0 bytes\n", + "b: UTF8 off, undef\n", + "String b is undef, string a has 0 characters\n"); +is(data_diff("aaa","aba"), + join "","a: UTF8 off, ASCII, 3 characters 3 bytes\n", + "b: UTF8 off, ASCII, 3 characters 3 bytes\n", + "Strings differ at index 1: a[1]=a, b[1]=b\n"); +is(data_diff(pack("C",0xEA), pack("U",0xEA)), + join "", "a: UTF8 off, non-ASCII, 1 characters 1 bytes\n", + "b: UTF8 on, non-ASCII, 1 characters 2 bytes\n", + "Strings contain the same sequence of characters\n"); +is(data_diff(pack("C",0xEA), pack("U",0xEA), 1), ""); # no logical difference + + +## ---------------------------------------------------------------------------- +# restrict this test to just developers + +SKIP: { + skip 'developer tests', 4 unless -d ".svn" || -d ".git"; + + if ($^O eq "MSWin32" && eval { require Win32API::File }) { + Win32API::File::SetErrorMode(Win32API::File::SEM_FAILCRITICALERRORS()); + } + + print "Test DBI->installed_versions (for @drivers)\n"; + print "(If one of those drivers, or the configuration for it, is bad\n"; + print "then these tests can kill or freeze the process here. That's not the DBI's fault.)\n"; + $SIG{ALRM} = sub { + die "Test aborted because a driver (one of: @drivers) hung while loading" + ." (almost certainly NOT a DBI problem)"; + }; + alarm(20); + + ## ---------------------------------------------------------------------------- + ## test installed_versions + + # scalar context + my $installed_versions = DBI->installed_versions; + + is(ref($installed_versions), 'HASH', '... we got a hash of installed versions'); + cmp_ok(scalar(keys(%{$installed_versions})), '>=', 1, '... make sure we have at least one'); + + # list context + my @installed_drivers = DBI->installed_versions; + + cmp_ok(scalar(@installed_drivers), '>=', 1, '... make sure we got at least one'); + like("@installed_drivers", qr/Sponge/, '... make sure at least one of them is DBD::Sponge'); +} + +## testing dbi_debug + +cmp_ok($DBI::dbi_debug, '==', 0, "... DBI::dbi_debug's initial state is 0"); + +SKIP: { + my $null = File::Spec->devnull(); + skip "cannot find : $null", 2 unless ($^O eq "MSWin32" || -e $null); + + DBI->trace(15,$null); + cmp_ok($DBI::dbi_debug, '==', 15, "... DBI::dbi_debug is 15"); + DBI->trace(0, undef); + cmp_ok($DBI::dbi_debug, '==', 0, "... DBI::dbi_debug is 0"); +} + +1; |