Blame t/10_create_aggregate.t

Packit 723767
#!/usr/bin/perl
Packit 723767
Packit 723767
use strict;
Packit 723767
BEGIN {
Packit 723767
	$|  = 1;
Packit 723767
	$^W = 1;
Packit 723767
}
Packit 723767
Packit 723767
use lib "t/lib";
Packit 723767
use SQLiteTest qw/connect_ok @CALL_FUNCS/;
Packit 723767
use Test::More;
Packit 723767
use Test::NoWarnings;
Packit 723767
use DBD::SQLite;
Packit 723767
use DBD::SQLite::Constants;
Packit 723767
Packit 723767
my @function_flags = (undef, 0);
Packit 723767
if ($DBD::SQLite::sqlite_version_number >= 3008003) {
Packit 723767
  push @function_flags, DBD::SQLite::Constants::SQLITE_DETERMINISTIC;
Packit 723767
}
Packit 723767
Packit 723767
plan tests => 21 * @CALL_FUNCS * @function_flags + 1;
Packit 723767
Packit 723767
# Create the aggregate test packages
Packit 723767
SCOPE: {
Packit 723767
	package count_aggr;
Packit 723767
Packit 723767
	sub new {
Packit 723767
		bless { count => 0 }, shift;
Packit 723767
	}
Packit 723767
Packit 723767
	sub step {
Packit 723767
		$_[0]{count}++;
Packit 723767
		return;
Packit 723767
	}
Packit 723767
Packit 723767
	sub finalize {
Packit 723767
		my $c = $_[0]{count};
Packit 723767
		$_[0]{count} = undef;
Packit 723767
Packit 723767
		return $c;
Packit 723767
	}
Packit 723767
Packit 723767
	package obj_aggregate;
Packit 723767
Packit 723767
	sub new {
Packit 723767
		bless { count => 0 }, shift;
Packit 723767
	}
Packit 723767
Packit 723767
	sub step {
Packit 723767
		$_[0]{count}++ if defined $_[1];
Packit 723767
	}
Packit 723767
Packit 723767
	sub finalize {
Packit 723767
		my $c = $_[0]{count};
Packit 723767
		$_[0]{count} = undef;
Packit 723767
		return $c;
Packit 723767
	}
Packit 723767
Packit 723767
	package fail_aggregate;
Packit 723767
Packit 723767
	sub new {
Packit 723767
		my $class = shift;
Packit 723767
		if ( ref $class ) {
Packit 723767
			die "new() failed on request" if $class->{'fail'} eq 'new';
Packit 723767
			return undef if $class->{'fail'} eq 'undef';
Packit 723767
			return bless { %$class }, ref $class;
Packit 723767
		} else {
Packit 723767
			return bless { 'fail' => $_[0] }, $class;
Packit 723767
		}
Packit 723767
	}
Packit 723767
Packit 723767
	sub step {
Packit 723767
		die "step() failed on request" if $_[0]{fail} eq 'step';
Packit 723767
	}
Packit 723767
Packit 723767
	sub finalize {
Packit 723767
		die "finalize() failed on request" if $_[0]{fail} eq 'finalize';
Packit 723767
	}
Packit 723767
}
Packit 723767
Packit 723767
foreach my $call_func (@CALL_FUNCS) { for my $flags (@function_flags) {
Packit 723767
	my $dbh = connect_ok( PrintError => 0 );
Packit 723767
Packit 723767
	$dbh->do( "CREATE TABLE aggr_test ( field )" );
Packit 723767
	foreach my $val ( qw/NULL 1 'test'/ ) {
Packit 723767
	    $dbh->do( "INSERT INTO aggr_test VALUES ( $val )" );
Packit 723767
	}
Packit 723767
Packit 723767
	ok($dbh->$call_func( "newcount", 0, "count_aggr", defined $flags ? $flags : (), "create_aggregate" ));
Packit 723767
	my $result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_test" );
Packit 723767
	ok( $result && $result->[0] == 3 );
Packit 723767
Packit 723767
	# Make sure that the init() function is called correctly
Packit 723767
	$result = $dbh->selectall_arrayref( "SELECT newcount() FROM aggr_test GROUP BY field" );
Packit 723767
	ok( @$result == 3 && $result->[0][0] == 1 && $result->[1][0] == 1 );
Packit 723767
Packit 723767
Packit 723767
	# Test aggregate on empty table
Packit 723767
	$dbh->do( "DROP TABLE aggr_empty_test;" );
Packit 723767
	$dbh->do( "CREATE TABLE aggr_empty_test ( field )" );
Packit 723767
	$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
Packit 723767
	ok( $result && !$result->[0] );
Packit 723767
	# Make sure that the init() function is called correctly
Packit 723767
	$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
Packit 723767
	ok( $result && !$result->[0] );
Packit 723767
Packit 723767
	ok($dbh->$call_func( "defined", 1, 'obj_aggregate', defined $flags ? $flags : (), "create_aggregate" ));
Packit 723767
	$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
Packit 723767
	ok( $result && $result->[0] == 2 );
Packit 723767
	$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
Packit 723767
	ok( $result && $result->[0] == 2 );
Packit 723767
	$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
Packit 723767
	ok( $result && !$result->[0] );
Packit 723767
	$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
Packit 723767
	ok( $result && !$result->[0] );
Packit 723767
Packit 723767
	my $last_warn;
Packit 723767
	local $SIG{__WARN__} = sub { $last_warn = join "", @_ };
Packit 723767
	foreach my $fail ( qw/ new step finalize/ ) {
Packit 723767
	    $last_warn = '';  
Packit 723767
	    my $aggr = fail_aggregate->new( $fail );
Packit 723767
	    ok($dbh->$call_func( "fail_$fail", -1, $aggr, defined $flags ? $flags : (), 'create_aggregate' ));
Packit 723767
	    $result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_test" );
Packit 723767
	#   ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
Packit 723767
	    ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
Packit 723767
Packit 723767
	    # No need to check this one, since step() will never be called
Packit 723767
	    # on an empty table
Packit 723767
	    next if $fail eq 'step';
Packit 723767
	    $result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_empty_test" );
Packit 723767
	#    ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
Packit 723767
	    ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
Packit 723767
	}
Packit 723767
Packit 723767
	my $aggr = fail_aggregate->new( 'undef' );
Packit 723767
	$last_warn = '';
Packit 723767
	ok($dbh->$call_func( "fail_undef", -1, $aggr, defined $flags ? $flags : (), 'create_aggregate' ));
Packit 723767
	$result = $dbh->selectrow_arrayref( "SELECT fail_undef() FROM aggr_test" );
Packit 723767
	# ok( !$result && $DBI::errstr =~ /new\(\) should return a blessed reference/ );
Packit 723767
	ok( !defined $result->[0] && $last_warn =~ /new\(\) should return a blessed reference/ );
Packit 723767
Packit 723767
	$dbh->disconnect;
Packit 723767
}}