From 40d6ff35c1294222c545e5af52a3413ab8e7f213 Mon Sep 17 00:00:00 2001 From: Adam Kennedy Date: Sat, 4 Apr 2009 20:19:25 +0000 Subject: [PATCH] Rewrote 28_changestyle.t in Test::More style --- Changes | 5 ++ t/01_compile.t | 2 + t/28_schemachange.t | 157 ++++++++++++++++---------------------------- t/lib/Test.pm | 4 +- 4 files changed, 66 insertions(+), 102 deletions(-) diff --git a/Changes b/Changes index cfc58ef..af5ae7d 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,11 @@ Changes for Perl extension DBD-SQLite. +1.19_09 Sun 5 Apr 2009 - Require perl 5.6 because dependencies require it + - Adding $DBI::VERSION diag to help diagnose FAIL reports (ADAMK) + - #29519 was only resolved on Win32. Applied a more comprehensive + patch (JHEDDEN) + - Rewrote 28_schemachange.t in Test::More style (ADAMK) 1.19_08 Sat 4 Apr 2009 - Bumped minimum DBI dependency to 1.43 so last_insert_id is supported diff --git a/t/01_compile.t b/t/01_compile.t index 49cdbcc..f7fefca 100644 --- a/t/01_compile.t +++ b/t/01_compile.t @@ -16,3 +16,5 @@ ok( $] >= 5.00503, 'Perl version is new enough' ); use_ok('DBI'); use_ok('DBD::SQLite'); use_ok('t::lib::Test'); + +diag("\$DBI::VERSION=$DBI::VERSION"); diff --git a/t/28_schemachange.t b/t/28_schemachange.t index 306a109..fed69d2 100644 --- a/t/28_schemachange.t +++ b/t/28_schemachange.t @@ -1,100 +1,57 @@ -#!/usr/bin/perl - -use strict; -BEGIN { - $| = 1; - $^W = 1; -} - -use t::lib::Test; - -#if ($^O eq 'MSWin32') { -# print "1..0 # Skip changing active database's schema doesn't work under Windows\n"; -# exit 0; -#} - -do 't/lib.pl'; -if ($@) { - print STDERR "Error while executing lib.pl: $@\n"; - exit 10; -} - -sub ServerError() { - print STDERR ("Cannot connect: ", $DBI::errstr, "\n"); - exit 10; -} - -# Main loop; leave this untouched, put tests into the loop -use vars qw($state); -while (Testing()) { - # Connect to the database - my $dbh; - Test($state or $dbh = DBI->connect("DBI:SQLite:dbname=foo", '', '')) - or ServerError(); - - # Create some tables - my $table1; - Test($state or $table1 = FindNewTable($dbh)) - or DbiError($dbh->err, $dbh->errstr); - my $create1; - if (!$state) { - ($create1 = TableDefinition($table1, - ["id", "INTEGER", 4, 0], - ["name", "CHAR", 64, 0])); - print "Creating table:\n$create1\n"; - } - Test($state or $dbh->do($create1)) - or DbiError($dbh->err, $dbh->errstr); - - my $table2; - Test($state or $table2 = FindNewTable($dbh)) - or DbiError($dbh->err, $dbh->errstr); - my $create2; - if (!$state) { - ($create2 = TableDefinition($table2, - ["id", "INTEGER", 4, 0], - ["name", "CHAR", 64, 0])); - print "Creating table:\n$create2\n"; - } - Test($state or $dbh->do($create2)) - or DbiError($dbh->err, $dbh->errstr); - - my $pid; - if ( not defined($pid = fork()) ) { - die("fork: $!"); - } elsif ( $pid == 0 ) { - # Child: drop the second table - if ( $^O =~ /win32/i ) { - # sqlite prohibits thread sharing parent connection - $dbh = DBI->connect("DBI:SQLite:dbname=foo", '', ''); - } - if ( not $state ) { - $dbh->do("DROP TABLE $table2") - or DbiError($dbh->err, $dbh->errstr); - $dbh->disconnect() - or DbiError($dbh->err, $dbh->errstr); - } - exit(0); - } - - # Parent: wait for the child to finish, then attempt to use the database - Test(waitpid($pid, 0) != -1) or print("waitpid: $!\n"); - - if ( $^O =~ /win32/i ) { - # schema changed, need to reconnect - $dbh = DBI->connect("DBI:SQLite:dbname=foo", '', ''); - } - - Test($state or $dbh->do("DROP TABLE $table1")) - or DbiError($dbh->err, $dbh->errstr); - - # Make sure the child actually deleted table2. This will fail if - # table2 still exists. - Test($state or $dbh->do($create2)) - or DbiError($dbh->err, $dbh->errstr); - - # Disconnect - Test($state or $dbh->disconnect()) - or DbiError($dbh->err, $dbh->errstr); -} - +#!/usr/bin/perl + +# This test works, but as far as I can tell this doesn't actually test +# the thing that the test was originally meant to test. + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 5; +use t::lib::Test; + +my $create1 = 'CREATE TABLE table1 (id INTEGER NOT NULL, name CHAR (64) NOT NULL)'; +my $create2 = 'CREATE TABLE table2 (id INTEGER NOT NULL, name CHAR (64) NOT NULL)'; +my $drop1 = 'DROP TABLE table1'; +my $drop2 = 'DROP TABLE table2'; + +# diag("Parent starting... ($$)"); + +# Create the tables +SCOPE: { + my $dbh = DBI->connect('dbi:SQLite:dbname=foo', '', '') or die 'connect failed'; + $dbh->do($create1) or die '$create1 failed'; + $dbh->do($create2) or die '$create2 failed'; + $dbh->disconnect or die 'disconnect failed'; +} + +my $pid; +# diag("Forking... ($$)"); +if ( not defined( $pid = fork() ) ) { + die("fork: $!"); + +} elsif ( $pid == 0 ) { + # Child process + # diag("Child starting... ($$)"); + my $dbh = connect_ok(); + ok( $dbh->do($drop2), $drop2 ); + ok( $dbh->disconnect, '->disconnect ok' ); + # diag("Child exiting... ($$)"); + exit(0); + +} else { + # Parent process + # diag("Waiting for child... ($$)"); + ok( waitpid($pid, 0) != -1, "waitpid" ); + +} + +# Make sure the child actually deleted table2 +SCOPE: { + my $dbh = connect_ok(); + ok( $dbh->do($drop1), $drop1 ); + ok( $dbh->do($create2), $create2 ); + ok( $dbh->disconnect, '->disconnect ok' ); +} diff --git a/t/lib/Test.pm b/t/lib/Test.pm index 3b950e1..738e9d8 100644 --- a/t/lib/Test.pm +++ b/t/lib/Test.pm @@ -26,11 +26,11 @@ sub clean { # Clean up temporary test files both at the beginning and end of the # test script. BEGIN { clean() } -END { clean() } +# END { clean() } # A simplified connect function for the most common case sub connect_ok { - my @params = ( "dbi:SQLite:dbname=foo", "", "" ); + my @params = ( 'dbi:SQLite:dbname=foo', '', '' ); if ( @_ ) { push @params, { @_ }; }