Give tests prefixes so they run in a predictable order.
This commit is contained in:
Colin Kuskie
parent
2c780536e8
commit
0ae4882906
1 changed files with 131 additions and 116 deletions
|
|
@ -78,7 +78,93 @@ sub _constructor : Test(4) {
|
|||
|
||||
}
|
||||
|
||||
sub title : Test(6) {
|
||||
sub t_00_class_dispatch : Test(2) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
note "Class dispatch";
|
||||
my $asset = $test->class->new({session => $session});
|
||||
|
||||
my $asset = WebGUI::Asset->new({
|
||||
session => $session,
|
||||
title => 'testing snippet',
|
||||
className => 'WebGUI::Asset::Snippet',
|
||||
});
|
||||
|
||||
isa_ok $asset, 'WebGUI::Asset';
|
||||
is $asset->className, 'WebGUI::Asset', 'passing className is ignored';
|
||||
}
|
||||
|
||||
sub t_00_get_tables : Test(1) {
|
||||
my $test = shift;
|
||||
note "get_tables";
|
||||
my @tables = $test->class->meta->get_tables;
|
||||
cmp_bag(
|
||||
\@tables,
|
||||
$test->list_of_tables,
|
||||
'Set of tables for properties is correct'
|
||||
);
|
||||
}
|
||||
|
||||
sub t_00_getParent : Test(2) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
note "getParent";
|
||||
my $testId1 = 'wg8TestAsset0000000001';
|
||||
my $testId2 = 'wg8TestAsset0000000002';
|
||||
my $now = time();
|
||||
my $baseLineage = $session->db->quickScalar('select lineage from asset where assetId=?',['PBasset000000000000002']);
|
||||
my $testLineage = $baseLineage. '909090';
|
||||
$session->db->write("insert into asset (assetId, className, lineage) VALUES (?,?,?)", [$testId1, 'WebGUI::Asset', $testLineage]);
|
||||
$session->db->write("insert into assetData (assetId, revisionDate, status) VALUES (?,?,?)", [$testId1, $now, 'approved']);
|
||||
my $testLineage2 = $testLineage . '000001';
|
||||
$session->db->write("insert into asset (assetId, className, parentId, lineage) VALUES (?,?,?,?)", [$testId2, 'WebGUI::Asset', $testId1, $testLineage2]);
|
||||
$session->db->write("insert into assetData (assetId, revisionDate) VALUES (?,?)", [$testId2, $now]);
|
||||
|
||||
my $testAsset = WebGUI::Asset->new($session, $testId2, $now);
|
||||
is $testAsset->parentId, $testId1, 'parentId assigned correctly on db fetch in new';
|
||||
my $testParent = $testAsset->getParent();
|
||||
isa_ok $testParent, 'WebGUI::Asset';
|
||||
|
||||
$session->db->write("delete from asset where assetId like 'wg8TestAsset00000%'");
|
||||
$session->db->write("delete from assetData where assetId like 'wg8TestAsset00000%'");
|
||||
}
|
||||
|
||||
sub t_00_newByPropertyHashRef : Test(2) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
note "newByPropertyHashRef";
|
||||
my $asset;
|
||||
$asset = WebGUI::Asset->newByPropertyHashRef($session, {className => $test->class, title => 'The Shawshank Snippet'});
|
||||
isa_ok $asset, $test->class;
|
||||
is $asset->title, 'The Shawshank Snippet', 'title is assigned from the property hash';
|
||||
}
|
||||
|
||||
sub t_00_scan_properties : Test(1) {
|
||||
note "scan properties for table definitions";
|
||||
my $test = shift;
|
||||
my @properties = $test->class->meta->get_all_properties;
|
||||
my @undefined_tables = ();
|
||||
foreach my $prop (@properties) {
|
||||
push @undefined_tables, $prop->name if (!$prop->tableName);
|
||||
}
|
||||
ok !@undefined_tables, "all properties have tables defined"
|
||||
or diag "except these: ".join ", ", @undefined_tables;
|
||||
}
|
||||
|
||||
sub t_01_assetId : Test(4) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
my $asset = $test->class->new({session => $session});
|
||||
note "assetId, getId";
|
||||
can_ok $asset, qw/assetId getId/;
|
||||
ok $session->id->valid( $asset->assetId), 'assetId generated by default is valid';
|
||||
is $asset->assetId, $asset->getId, '... getId is an alias for assetId';
|
||||
|
||||
$asset = $test->class->new({ session => $session, assetId => '' });
|
||||
ok !$session->id->valid($asset->assetId), 'blank assetId in constructor is okay??';
|
||||
}
|
||||
|
||||
sub t_01_title : Test(6) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
my $asset = $test->class->new({session => $session});
|
||||
|
|
@ -100,7 +186,7 @@ sub title : Test(6) {
|
|||
|
||||
}
|
||||
|
||||
sub menuTitle : Test(8) {
|
||||
sub t_01_menuTitle : Test(8) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
my $asset = $test->class->new({session => $session});
|
||||
|
|
@ -136,36 +222,7 @@ sub menuTitle : Test(8) {
|
|||
is $asset->menuTitle, 'menuTitle asset', '... set via constructor';
|
||||
}
|
||||
|
||||
sub assetId : Test(4) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
my $asset = $test->class->new({session => $session});
|
||||
note "assetId, getId";
|
||||
can_ok $asset, qw/assetId getId/;
|
||||
ok $session->id->valid( $asset->assetId), 'assetId generated by default is valid';
|
||||
is $asset->assetId, $asset->getId, '... getId is an alias for assetId';
|
||||
|
||||
$asset = $test->class->new({ session => $session, assetId => '' });
|
||||
ok !$session->id->valid($asset->assetId), 'blank assetId in constructor is okay??';
|
||||
}
|
||||
|
||||
sub class_dispatch : Test(2) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
note "Class dispatch";
|
||||
my $asset = $test->class->new({session => $session});
|
||||
|
||||
my $asset = WebGUI::Asset->new({
|
||||
session => $session,
|
||||
title => 'testing snippet',
|
||||
className => 'WebGUI::Asset::Snippet',
|
||||
});
|
||||
|
||||
isa_ok $asset, 'WebGUI::Asset';
|
||||
is $asset->className, 'WebGUI::Asset', 'passing className is ignored';
|
||||
}
|
||||
|
||||
sub uiLevel : Test(1) {
|
||||
sub t_01_uiLevel : Test(1) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
note "uiLevel";
|
||||
|
|
@ -173,7 +230,7 @@ sub uiLevel : Test(1) {
|
|||
is $asset->uiLevel, $test->assetUiLevel, 'asset uiLevel check';
|
||||
}
|
||||
|
||||
sub write_update : Test(8) {
|
||||
sub t_01_write_update : Test(8) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
note "write, update";
|
||||
|
|
@ -210,89 +267,7 @@ sub write_update : Test(8) {
|
|||
$session->db->write("delete from assetData where assetId=?", [$testId]);
|
||||
}
|
||||
|
||||
sub keywords : Test(3) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
my ($tag, $asset, @parents) = $test->getAnchoredAsset();
|
||||
can_ok $asset, 'keywords';
|
||||
$asset->keywords('chess set');
|
||||
is $asset->keywords, 'chess set', 'set and get of keywords via direct accessor';
|
||||
is $asset->get('keywords'), 'chess set', 'via get method';
|
||||
}
|
||||
|
||||
sub get_tables : Test(1) {
|
||||
my $test = shift;
|
||||
note "get_tables";
|
||||
my @tables = $test->class->meta->get_tables;
|
||||
cmp_bag(
|
||||
\@tables,
|
||||
$test->list_of_tables,
|
||||
'Set of tables for properties is correct'
|
||||
);
|
||||
}
|
||||
|
||||
sub getParent : Test(2) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
note "getParent";
|
||||
my $testId1 = 'wg8TestAsset0000000001';
|
||||
my $testId2 = 'wg8TestAsset0000000002';
|
||||
my $now = time();
|
||||
my $baseLineage = $session->db->quickScalar('select lineage from asset where assetId=?',['PBasset000000000000002']);
|
||||
my $testLineage = $baseLineage. '909090';
|
||||
$session->db->write("insert into asset (assetId, className, lineage) VALUES (?,?,?)", [$testId1, 'WebGUI::Asset', $testLineage]);
|
||||
$session->db->write("insert into assetData (assetId, revisionDate, status) VALUES (?,?,?)", [$testId1, $now, 'approved']);
|
||||
my $testLineage2 = $testLineage . '000001';
|
||||
$session->db->write("insert into asset (assetId, className, parentId, lineage) VALUES (?,?,?,?)", [$testId2, 'WebGUI::Asset', $testId1, $testLineage2]);
|
||||
$session->db->write("insert into assetData (assetId, revisionDate) VALUES (?,?)", [$testId2, $now]);
|
||||
|
||||
my $testAsset = WebGUI::Asset->new($session, $testId2, $now);
|
||||
is $testAsset->parentId, $testId1, 'parentId assigned correctly on db fetch in new';
|
||||
my $testParent = $testAsset->getParent();
|
||||
isa_ok $testParent, 'WebGUI::Asset';
|
||||
|
||||
$session->db->write("delete from asset where assetId like 'wg8TestAsset00000%'");
|
||||
$session->db->write("delete from assetData where assetId like 'wg8TestAsset00000%'");
|
||||
}
|
||||
|
||||
sub newByPropertyHashRef : Test(2) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
note "newByPropertyHashRef";
|
||||
my $asset;
|
||||
$asset = WebGUI::Asset->newByPropertyHashRef($session, {className => $test->class, title => 'The Shawshank Snippet'});
|
||||
isa_ok $asset, $test->class;
|
||||
is $asset->title, 'The Shawshank Snippet', 'title is assigned from the property hash';
|
||||
}
|
||||
|
||||
sub scan_properties : Test(1) {
|
||||
note "scan properties for table definitions";
|
||||
my $test = shift;
|
||||
my @properties = $test->class->meta->get_all_properties;
|
||||
my @undefined_tables = ();
|
||||
foreach my $prop (@properties) {
|
||||
push @undefined_tables, $prop->name if (!$prop->tableName);
|
||||
}
|
||||
ok !@undefined_tables, "all properties have tables defined"
|
||||
or diag "except these: ".join ", ", @undefined_tables;
|
||||
}
|
||||
|
||||
sub purge : Test(3) {
|
||||
note "purge";
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
my ($tag, $asset, @parents) = $test->getAnchoredAsset();
|
||||
my @tables = $asset->meta->get_tables;
|
||||
ok $asset->purge, 'purge returns true if it was purged';
|
||||
throws_ok { WebGUI::Asset->newById($session, $asset->assetId); } 'WebGUI::Error::InvalidParam', 'Unable to fetch asset by assetId now';
|
||||
my $exists_in_table = 0;
|
||||
foreach my $table (@tables) {
|
||||
$exists_in_table ||= $session->db->quickScalar("select count(*) from `$table` where assetId=?",[$asset->assetId]);
|
||||
}
|
||||
ok ! $exists_in_table, 'assetId removed from all asset tables';
|
||||
}
|
||||
|
||||
sub cut_paste : Test(5) {
|
||||
sub t_03_addRevision : Test(5) {
|
||||
note "cut";
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
|
|
@ -308,6 +283,46 @@ sub cut_paste : Test(5) {
|
|||
$session->asset($session_asset);
|
||||
}
|
||||
|
||||
sub t_05_cut_paste : Test(5) {
|
||||
note "cut";
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
my ($tag, $asset, @parents) = $test->getAnchoredAsset();
|
||||
ok $asset->cut, 'cut returns true if it was cut';
|
||||
is $asset->state, 'clipboard', 'asset state updated';
|
||||
my $session_asset = $session->asset();
|
||||
$session->asset($parents[-1]);
|
||||
ok $asset->canPaste, 'canPaste: allowed to paste here';
|
||||
ok $parents[-1]->paste($asset->assetId), 'paste returns true when it pastes';
|
||||
$asset_prime = $asset->cloneFromDb;
|
||||
is $asset_prime->state, 'published', 'asset state updated';
|
||||
$session->asset($session_asset);
|
||||
}
|
||||
|
||||
sub t_05_keywords : Test(3) {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
my ($tag, $asset, @parents) = $test->getAnchoredAsset();
|
||||
can_ok $asset, 'keywords';
|
||||
$asset->keywords('chess set');
|
||||
is $asset->keywords, 'chess set', 'set and get of keywords via direct accessor';
|
||||
is $asset->get('keywords'), 'chess set', 'via get method';
|
||||
}
|
||||
|
||||
sub t_05_purge : Test(3) {
|
||||
note "purge";
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
my ($tag, $asset, @parents) = $test->getAnchoredAsset();
|
||||
my @tables = $asset->meta->get_tables;
|
||||
ok $asset->purge, 'purge returns true if it was purged';
|
||||
throws_ok { WebGUI::Asset->newById($session, $asset->assetId); } 'WebGUI::Error::InvalidParam', 'Unable to fetch asset by assetId now';
|
||||
my $exists_in_table = 0;
|
||||
foreach my $table (@tables) {
|
||||
$exists_in_table ||= $session->db->quickScalar("select count(*) from `$table` where assetId=?",[$asset->assetId]);
|
||||
}
|
||||
ok ! $exists_in_table, 'assetId removed from all asset tables';
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue