Rewrote 28_changestyle.t in Test::More style

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

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");

t/28_schemachange.t

@@ -1,100 +1,57 @@
 #!/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;
 
-#if ($^O eq 'MSWin32') {
+my $create1 = 'CREATE TABLE table1 (id INTEGER NOT NULL, name CHAR (64) NOT NULL)';
-#    print "1..0 # Skip changing active database's schema doesn't work under Windows\n";
+my $create2 = 'CREATE TABLE table2 (id INTEGER NOT NULL, name CHAR (64) NOT NULL)';
-#    exit 0;
+my $drop1   = 'DROP TABLE table1';
-#}
+my $drop2   = 'DROP TABLE table2';
 
-do 't/lib.pl';
+# diag("Parent starting... ($$)");
-if ($@) {
+
-	print STDERR "Error while executing lib.pl: $@\n";
+# Create the tables
-	exit 10;
+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';
 }
 
-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;
+# diag("Forking... ($$)");
 if ( not defined( $pid = fork() ) ) {
 	die("fork: $!");
+
 } elsif ( $pid == 0 ) {
-    # Child: drop the second table
+	# Child process
-    if ( $^O =~ /win32/i ) {
+	# diag("Child starting... ($$)");
-      # sqlite prohibits thread sharing parent connection
+	my $dbh = connect_ok();
-      $dbh = DBI->connect("DBI:SQLite:dbname=foo", '', '');
+	ok( $dbh->do($drop2), $drop2 );
-    }
+	ok( $dbh->disconnect, '->disconnect ok' );
-    if ( not $state ) {
+	# diag("Child exiting... ($$)");
-      $dbh->do("DROP TABLE $table2")
-          or DbiError($dbh->err, $dbh->errstr);
-      $dbh->disconnect()
-          or DbiError($dbh->err, $dbh->errstr);
-    }
 	exit(0);
+
+} else {
+	# Parent process
+	# diag("Waiting for child... ($$)");
+	ok( waitpid($pid, 0) != -1, "waitpid" );
+
 }
 
-  # Parent: wait for the child to finish, then attempt to use the database
+# Make sure the child actually deleted table2
-  Test(waitpid($pid, 0) != -1) or print("waitpid: $!\n");
+SCOPE: {
-
+	my $dbh = connect_ok();
-  if ( $^O =~ /win32/i ) {
+	ok( $dbh->do($drop1),   $drop1   );
-    # schema changed, need to reconnect
+	ok( $dbh->do($create2), $create2 );
-    $dbh = DBI->connect("DBI:SQLite:dbname=foo", '', '');
+	ok( $dbh->disconnect, '->disconnect ok' );
 }
-
-  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);
-}
-

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, { @_ };
 	}