Author: petdance
Date: Tue May 11 12:48:15 2004
New Revision: 339
Modified:
dbi/trunk/t/60preparse.t
Log:
Updated to use good ol' Test::More
Modified: dbi/trunk/t/60preparse.t
==============================================================================
--- dbi/trunk/t/60preparse.t (original)
+++ dbi/trunk/t/60preparse.t Tue May 11 12:48:15 2004
@@ -1,20 +1,22 @@
-#!perl -w
+#!perl -Tw
use DBI qw(:preparse_flags);
$|=1;
-sub ok($;$);
-if ($DBI::PurePerl) {
- print "1..0 # Skipped: preparse not supported for DBI::PurePerl\n";
- exit 0;
+BEGIN {
+ if ($DBI::PurePerl) {
+ print "1..0 # Skipped: preparse not supported for DBI::PurePerl\n";
+ exit 0;
+ }
}
-print "1..$tests\n";
+use Test::More tests=>39;
my $dbh = DBI->connect("dbi:ExampleP:", "", "", {
PrintError => 0,
});
+isa_ok( $dbh, 'DBI::db' );
sub pp {
my $dbh = shift;
@@ -46,123 +48,99 @@
## Comments:
- ok pp($dbh, "a#b\nc", DBIpp_cm_cs, DBIpp_cm_hs), "a/*b*/\nc";
- ok pp($dbh, "a#b\nc", DBIpp_cm_dw, DBIpp_cm_hs), "a-- b\nc";
- ok pp($dbh, "a/*b*/c", DBIpp_cm_hs, DBIpp_cm_cs), "a#b\nc";
- ok pp($dbh, "a{b}c", DBIpp_cm_cs, DBIpp_cm_br), "a/*b*/c";
- ok pp($dbh, "a--b\nc", DBIpp_cm_br, DBIpp_cm_dd), "a{b}\nc";
+is( pp($dbh, "a#b\nc", DBIpp_cm_cs, DBIpp_cm_hs), "a/*b*/\nc" );
+is( pp($dbh, "a#b\nc", DBIpp_cm_dw, DBIpp_cm_hs), "a-- b\nc" );
+is( pp($dbh, "a/*b*/c", DBIpp_cm_hs, DBIpp_cm_cs), "a#b\nc" );
+is( pp($dbh, "a{b}c", DBIpp_cm_cs, DBIpp_cm_br), "a/*b*/c" );
+is( pp($dbh, "a--b\nc", DBIpp_cm_br, DBIpp_cm_dd), "a{b}\nc" );
- ok pp($dbh, "a-- b\n/*c*/d", DBIpp_cm_br, DBIpp_cm_cs|DBIpp_cm_dw), "a{ b}\n{c}d";
- ok pp($dbh, "a/*b*/c#d\ne--f\nh-- i\nj{k}", 0, DBIpp_cm_XX), "a c\ne\nh\nj ";
+is( pp($dbh, "a-- b\n/*c*/d", DBIpp_cm_br, DBIpp_cm_cs|DBIpp_cm_dw), "a{ b}\n{c}d" );
+is( pp($dbh, "a/*b*/c#d\ne--f\nh-- i\nj{k}", 0, DBIpp_cm_XX), "a c\ne\nh\nj " );
## Placeholders:
- ok pp($dbh, "a = :1", DBIpp_ph_qm, DBIpp_ph_cn), "a = ?";
- ok pp($dbh, "a = :1", DBIpp_ph_sp, DBIpp_ph_cn), "a = %s";
- ok pp($dbh, "a = ?" , DBIpp_ph_cn, DBIpp_ph_qm), "a = :p1";
- ok pp($dbh, "a = ?" , DBIpp_ph_sp, DBIpp_ph_qm), "a = %s";
+is( pp($dbh, "a = :1", DBIpp_ph_qm, DBIpp_ph_cn), "a = ?" );
+is( pp($dbh, "a = :1", DBIpp_ph_sp, DBIpp_ph_cn), "a = %s" );
+is( pp($dbh, "a = ?" , DBIpp_ph_cn, DBIpp_ph_qm), "a = :p1" );
+is( pp($dbh, "a = ?" , DBIpp_ph_sp, DBIpp_ph_qm), "a = %s" );
- ok pp($dbh, "a = :name", DBIpp_ph_qm, DBIpp_ph_cs), "a = ?";
- ok pp($dbh, "a = :name", DBIpp_ph_sp, DBIpp_ph_cs), "a = %s";
+is( pp($dbh, "a = :name", DBIpp_ph_qm, DBIpp_ph_cs), "a = ?" );
+is( pp($dbh, "a = :name", DBIpp_ph_sp, DBIpp_ph_cs), "a = %s" );
- ok pp($dbh, "a = ? b = ? c = ?", DBIpp_ph_cn, DBIpp_ph_XX), "a = :p1 b = :p2 c =
:p3";
+is( pp($dbh, "a = ? b = ? c = ?", DBIpp_ph_cn, DBIpp_ph_XX), "a = :p1 b = :p2 c =
:p3" );
## Placeholders inside comments (should be ignored where comments style is accepted):
- ok pp( $dbh,
+is( pp( $dbh,
"a = ? /*b = :1*/ c = ?",
DBIpp_cm_dw|DBIpp_ph_cn,
DBIpp_cm_cs|DBIpp_ph_qm),
- "a = :p1 -- b = :1\n c = :p2";
+ "a = :p1 -- b = :1\n c = :p2" );
## Placeholders inside single and double quotes (should be ignored):
- ok pp( $dbh,
+is( pp( $dbh,
"a = ? 'b = :1' c = ?",
DBIpp_ph_cn,
DBIpp_ph_XX),
- "a = :p1 'b = :1' c = :p2";
+ "a = :p1 'b = :1' c = :p2" );
- ok pp( $dbh,
+is( pp( $dbh,
'a = ? "b = :1" c = ?',
DBIpp_ph_cn,
DBIpp_ph_XX),
- 'a = :p1 "b = :1" c = :p2';
+ 'a = :p1 "b = :1" c = :p2' );
## Comments inside single and double quotes (should be ignored):
- ok pp( $dbh,
+is( pp( $dbh,
"a = ? '{b = :1}' c = ?",
DBIpp_cm_cs|DBIpp_ph_cn,
DBIpp_cm_XX|DBIpp_ph_qm),
- "a = :p1 '{b = :1}' c = :p2";
+ "a = :p1 '{b = :1}' c = :p2" );
- ok pp( $dbh,
+is( pp( $dbh,
'a = ? "/*b = :1*/" c = ?',
DBIpp_cm_dw|DBIpp_ph_cn,
DBIpp_cm_XX|DBIpp_ph_qm),
- 'a = :p1 "/*b = :1*/" c = :p2';
+ 'a = :p1 "/*b = :1*/" c = :p2' );
## Single and double quoted strings starting inside comments (should be ignored):
- ok pp( $dbh,
+is( pp( $dbh,
'a = ? /*"b = :1 */ c = ?',
DBIpp_cm_br|DBIpp_ph_cn,
DBIpp_cm_XX|DBIpp_ph_qm),
- 'a = :p1 {"b = :1 } c = :p2';
+ 'a = :p1 {"b = :1 } c = :p2' );
## Check error conditions are trapped:
- ok pp($dbh, "a = :value and b = :1", DBIpp_ph_qm, DBIpp_ph_cs|DBIpp_ph_cn), undef;
- ok $DBI::err;
- ok $DBI::errstr, "preparse found mixed placeholder styles (:1 / :name)";
-
- ok pp($dbh, "a = :1 and b = :3", DBIpp_ph_qm, DBIpp_ph_cn), undef;
- ok $DBI::err;
- ok $DBI::errstr, "preparse found placeholder :3 out of sequence, expected :2";
-
- ok pp($dbh, "foo ' comment", 0, 0), "foo ' comment";
- ok $DBI::err;
- ok $DBI::errstr, "preparse found unterminated single-quoted string";
-
- ok pp($dbh, 'foo " comment', 0, 0), 'foo " comment';
- ok $DBI::err;
- ok $DBI::errstr, "preparse found unterminated double-quoted string";
-
- ok pp($dbh, 'foo /* comment', DBIpp_cm_XX, DBIpp_cm_XX), 'foo /* comment';
- ok $DBI::err;
- ok $DBI::errstr, "preparse found unterminated bracketed C-style comment";
-
- ok pp($dbh, 'foo { comment', DBIpp_cm_XX, DBIpp_cm_XX), 'foo { comment';
- ok $DBI::err;
- ok $DBI::errstr, "preparse found unterminated bracketed {...} comment";
+is( pp($dbh, "a = :value and b = :1", DBIpp_ph_qm, DBIpp_ph_cs|DBIpp_ph_cn), undef );
+ok( $DBI::err );
+is( $DBI::errstr, "preparse found mixed placeholder styles (:1 / :name)" );
+
+is( pp($dbh, "a = :1 and b = :3", DBIpp_ph_qm, DBIpp_ph_cn), undef );
+ok( $DBI::err );
+is( $DBI::errstr, "preparse found placeholder :3 out of sequence, expected :2" );
+
+is( pp($dbh, "foo ' comment", 0, 0), "foo ' comment" );
+ok( $DBI::err );
+is( $DBI::errstr, "preparse found unterminated single-quoted string" );
+
+is( pp($dbh, 'foo " comment', 0, 0), 'foo " comment' );
+ok( $DBI::err );
+is( $DBI::errstr, "preparse found unterminated double-quoted string" );
+
+is( pp($dbh, 'foo /* comment', DBIpp_cm_XX, DBIpp_cm_XX), 'foo /* comment' );
+ok( $DBI::err );
+is( $DBI::errstr, "preparse found unterminated bracketed C-style comment" );
+
+is( pp($dbh, 'foo { comment', DBIpp_cm_XX, DBIpp_cm_XX), 'foo { comment' );
+ok( $DBI::err );
+is( $DBI::errstr, "preparse found unterminated bracketed {...} comment" );
# --------------------------------------------------------------------- #
$dbh->disconnect;
-BEGIN { $tests = 38; }
-
-sub ok ($;$) {
- my ($result, $expected) = @_;
- my $ok;
- if (@_ == 1) {
- $ok = $result;
- } elsif (!defined $expected) {
- $ok = !defined $result;
- } elsif (!defined $result) {
- $ok = 0;
- } else {
- $ok = $result eq $expected;
- }
- ++$t;
- ($ok) ? print "ok $t\n" : print "not ok $t\n";
- $expected = "undef" if !defined $expected;
- $result = "undef" if !defined $result;
- $expected =~ s/\n/\\n/g;
- $result =~ s/\n/\\n/g;
- warn "# failed test $t at line ".(caller)[2]."\n\texpected [$expected],\n\t
got [$result]\n" unless $ok;
- return $ok;
-}
-
1;
