[svn:dbi] r14493 - in dbi/branches/sqlengine: lib/DBI t

[REHSACK]

Author: REHSACK
Date: Sun Oct 17 06:50:57 2010
New Revision: 14493

Added:
   dbi/branches/sqlengine/t/48dbi_dbd_sqlengine.t
Modified:
   dbi/branches/sqlengine/lib/DBI/DBD.pm

Log:
add new test script to test DBI::DBD::SqlEngine and enable it's
Nano-compat check in DBI::DBD


Modified: dbi/branches/sqlengine/lib/DBI/DBD.pm
==============================================================================
--- dbi/branches/sqlengine/lib/DBI/DBD.pm       (original)
+++ dbi/branches/sqlengine/lib/DBI/DBD.pm       Sun Oct 17 06:50:57 2010
@@ -3333,7 +3333,7 @@
                         q|END { delete $ENV{DBI_AUTOPROXY}; }| ],
        },
        n => {  name => "DBI::SQL::Nano",
-               match => qr/^(?:49dbd_file|5\ddbm_\w+|85gofer)\.t$/,
+               match => 
qr/^(?:48dbi_dbd_sqlengine|49dbd_file|5\ddbm_\w+|85gofer)\.t$/,
                add => [ q{$ENV{DBI_SQL_NANO} = 1},
                         q|END { delete $ENV{DBI_SQL_NANO}; }| ],
        },

Added: dbi/branches/sqlengine/t/48dbi_dbd_sqlengine.t
==============================================================================
--- (empty file)
+++ dbi/branches/sqlengine/t/48dbi_dbd_sqlengine.t      Sun Oct 17 06:50:57 2010
@@ -0,0 +1,81 @@
+#!perl -w
+$|=1;
+
+use strict;
+
+use Cwd;
+use File::Path;
+use File::Spec;
+use Test::More;
+
+my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||"") =~ /^dbi:Gofer.*transport=/i;
+
+my $tbl;
+BEGIN { $tbl = "db_". $$ . "_" };
+#END   { $tbl and unlink glob "${tbl}*" }
+
+use_ok ("DBI");
+use_ok ("DBI::DBD::SqlEngine");
+use_ok ("DBD::File");
+
+my $sql_statement = DBI::DBD::SqlEngine::Statement->isa('SQL::Statement');
+my $dbh = DBI->connect( "DBI:File:", undef, undef, { PrintError => 0, 
RaiseError => 0, } ); # Can't use DBI::DBD::SqlEngine direct
+
+for my $sql ( split "\n", <<"" )
+    CREATE TABLE foo (id INT, foo TEXT)
+    CREATE TABLE bar (id INT, baz TEXT)
+    INSERT INTO foo VALUES (1, "Hello world")
+    INSERT INTO bar VALUES (1, "Bugfixes welcome")
+    INSERT bar VALUES (2, "Bug reports, too")
+    SELECT foo FROM foo where ID=1
+    UPDATE bar SET id=5 WHERE baz="Bugfixes welcome"
+    DELETE FROM foo
+    DELETE FROM bar WHERE baz="Bugfixes welcome"
+
+{
+    my $sth;
+    $sql =~ s/^\s+//;
+    eval { $sth = $dbh->prepare( $sql ); };
+    ok( $sth, "prepare '$sql'" );
+}
+
+for my $line ( split "\n", <<"" )
+    Junk -- Junk
+    CREATE foo (id INT, foo TEXT) -- missing table
+    INSERT INTO bar (1, "Bugfixes welcome") -- missing "VALUES"
+    UPDATE bar id=5 WHERE baz="Bugfixes welcome" -- missing "SET"
+    DELETE * FROM foo -- waste between "DELETE" and "FROM"
+
+{
+    my $sth;
+    $line =~ s/^\s+//;
+    my ($sql, $test) = ( $line =~ m/^([^-]+)\s+--\s+(.*)$/ );
+    eval { $sth = $dbh->prepare( $sql ); };
+    ok( !$sth, "$test: prepare '$sql'" );
+}
+
+SKIP: {
+    # some SQL::Statement / SQL::Parser related tests
+    skip( "Not running with SQL::Statement", 3 ) unless ($sql_statement);
+    for my $line ( split "\n", <<"" )
+       Junk -- Junk
+       CREATE TABLE bar (id INT, baz CHARACTER VARYING(255)) -- invalid column 
type
+
+    {
+       my $sth;
+       $line =~ s/^\s+//;
+       my ($sql, $test) = ( $line =~ m/^([^-]+)\s+--\s+(.*)$/ );
+       eval { $sth = $dbh->prepare( $sql ); };
+       ok( !$sth, "$test: prepare '$sql'" );
+    }
+
+    my $dbh2 = DBI->connect( "DBI:File:", undef, undef, { sql_dialect => 
"ANSI" } );
+    my $sth;
+    eval { $sth = $dbh2->prepare( "CREATE TABLE foo (id INTEGER PRIMARY KEY, 
phrase CHARACTER VARYING(40) UNIQUE)" ); };
+    ok( $sth, "prepared statement using ANSI dialect" );
+    skip( "Gofer proxy prevents fetching embedded SQL::Parser object", 1 );
+    my $sql_parser = $dbh2->FETCH("sql_parser_object");
+    cmp_ok( $sql_parser->dialect(), "eq", "ANSI", "SQL::Parser has 'ANSI' as 
dialect" );
+}
+
+done_testing ();