big Moose Done Tests (for now)
Still stuck in test mode here in the Moose-Pen.
Today I am re-writing the '47_dynamic_gathers.t' test. Looking at the code I cannot really use any of it as my Gather concept moved from two array-refs (gathers,filters) to just a singleton of 'Gather' made up of, elements and condtions.
The test is a little simpler now as all I have to test for is when I add a 'gather' the 'elements' and 'conditions' are correctly passed down from the DA to the DAD and when I add another 'gather' the current one is overridden by the new one;
To start I created two gathers;
my $gather = {
elements => [
{
name => 'first_name',
view => 'People4'
},
{
name => 'last_name',
view => 'People5'
},
{
name => 'user_id',
view => 'People6'
}
],
conditions => [
{
left => {
name => 'last_name',
view => 'People7'
},
right => { value => 'test' },
operator => '=',
open_parentheses => 1,
close_parentheses => 0,
},
{
condition => 'AND',
left => {
name => 'first_name',
view => 'People8'
},
right => { value => 'test' },
operator => '=',
open_parentheses => 0,
close_parentheses => 1
}
]};
my $gather2 = {
elements => [
{
name => 'first_name',
view => 'People4'
},
],
conditions => [
{
left => {
name => 'last_name',
view => 'People7'
},
right => { value => 'test' },
operator => '=',
},
]};
and then used my standard tests from Test::Database::Accessor::Utils to check the firsts one;
ok( $da->add_gather($gather), "can add an single Dynamic gather" );
my $return = {};
$da->retrieve( Data::Test->new(), $return );
my $dad = $da->result->error(); #note to others this is a kludge for testing
Test::Database::Accessor::Utils::deep_predicate(
$gather->{conditions}, $da->dynamic_gather->conditions(),
$dad->gather->conditions(), 'Dynamic Gather condtions correct'
);
Test::Database::Accessor::Utils::deep_element(
$gather->{elements}, $da->dynamic_gather->elements(),
$dad->gather->elements(), 'Dynamic Gather elements correct'
);
and then I just added the second one and did the same tests as above;
$da->add_gather($gather2);
$return = {};
$da->retrieve( Data::Test->new(), $return );
$dad = $da->result->error(); #note to others this is a kludge for testing
Test::Database::Accessor::Utils::deep_predicate(
$gather2->{conditions}, $da->dynamic_gather->conditions(),
$dad->gather->conditions(), 'Dynamic Gather 2 condtions correct'
);
Test::Database::Accessor::Utils::deep_element(
$gather2->{elements}, $da->dynamic_gather->elements(),
$dad->gather->elements(), 'Dynamic Gather 2 elements correct'
);
and I get a full pass for both. Once I checked this in, I reran the full suite with this result
All tests successful.
Files=29, Tests=445, 79 wallclock secs ( 0.26 usr 0.07 sys + 76.64 cusr 2.29 csys = 79.26 CPU)
Result: PASS
That's good! Maybe I can get back on the Driver::DBI now, but since I am in test mode anyway I think I will give the Driver::DBI suite a test run first just to see the present state, so here we go;
t/10_crud_basic.t (Wstat: 65280 Tests: 17 Failed: 2)
t/20_where_basic.t (Wstat: 65280 Tests: 12 Failed: 1)
t/30_fields.t (Wstat: 65280 Tests: 17 Failed: 2)
t/32_params.t (Wstat: 65280 Tests: 9 Failed: 6)
so not too bad 11 fails and I know I am missing some coverage. Well might as well tackle the first one.
The fail on that test is;
DBD::DBM::st execute_array failed: 3 bind values supplied but 2
expected [for Statement "INSERT INTO user ( user.address, user.username ) VALUES( ?, ? )
WHERE user.username = ?"] at
and the test is simple enough;
$container = [Test::User->new({username=>'Bill',address =>'ABC'}),
{username=>'Jane',address =>'DEF'},
Test::User->new({username=>'John',address =>'HIJ'}),
{username=>'Joe',address =>'KLM'},
];
ok($user->create( $utils->connect(),$container),"Execute Array add 4");
unless($user->result()->is_error) {
ok(scalar(@{$user->result()->set}) == 4,"Four records added");
}else{
fail("Execute Array failed");
}
what is happening in the above is the 'Where' clause is being added to the insert statement. Now this is incorrect SQL as 'INSERT' does not support the 'WHERE' clause, I will have to fix that with this patch to the 'execute' sub
Database::Accessor::Constants::UPDATE ) {
$sql = $self->_update($container);
++ $sql .= $self->_where_clause();
}
elsif ( $action eq Database::Accessor::Constants::DELETE ) {
$sql = $self->_delete();
++ $sql .= $self->_where_clause();
}
else {
$sql = $self->_select();
++ $sql .= $self->_join_clause();
++ $sql .= $self->_where_clause();
++ $sql .= $self->_group_by_clause();
++ $sql .= $self->_order_by_clause();
}
-- $sql .= $self->_join_clause();
-- $sql .= $self->_where_clause();
-- $sql .= $self->_group_by_clause();
-- $sql .= $self->_order_by_clause();
Now I get my tests to run 100% correct, but that patch above is not 100% correct as I know you can use a 'JOIN' in a 'UPDATE', time to hit the books.
After reading though a number of SQL syntax books I think this might get me more coverage
}
elsif ( $action eq Database::Accessor::Constants::UPDATE ) {
$sql = $self->_update($container);
++ $sql .= $self->_join_clause();
$sql .= $self->_where_clause();
}
elsif ( $action eq Database::Accessor::Constants::DELETE ) {
$sql = $self->_delete();
++ $sql .= $self->_join_clause();
$sql .= $self->_where_clause();
}
else {
$sql = $self->_select();
$sql .= $self->_join_clause();
$sql .= $self->_where_clause();
$sql .= $self->_group_by_clause();
-- $sql .= $self->_order_by_clause();
}
++ $sql .= $self->_order_by_clause();
Funny never knew but all four of the CRUD actions can have a 'ORDER BY' clause. After that fix my tests still run so I will leave that along for a bit and go onto the next one '20_where_basic.t'.
I re-ran that test case and the above fixed it as well so onto '30_fields.t ' and I still get two fails;
...
not ok 7 - Function params correct
...
not ok 10 - Function within a function SQL correct
…
Looking at code for this test case and the next one '32_params.t' I realized that both are not using the nifty 'sql_param_ok' sub I created in the Test::Utils package so I think I will give these two a skip for now and re-write them at a later date to take advantage of that sub.
So that is one test suite running at 100% and one bug squished not a bad days work.
Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations
Leave a comment