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 $test = shift;
|
||||||
my $session = $test->session;
|
my $session = $test->session;
|
||||||
my $asset = $test->class->new({session => $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 $test = shift;
|
||||||
my $session = $test->session;
|
my $session = $test->session;
|
||||||
my $asset = $test->class->new({session => $session});
|
my $asset = $test->class->new({session => $session});
|
||||||
|
|
@ -136,36 +222,7 @@ sub menuTitle : Test(8) {
|
||||||
is $asset->menuTitle, 'menuTitle asset', '... set via constructor';
|
is $asset->menuTitle, 'menuTitle asset', '... set via constructor';
|
||||||
}
|
}
|
||||||
|
|
||||||
sub assetId : Test(4) {
|
sub t_01_uiLevel : Test(1) {
|
||||||
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) {
|
|
||||||
my $test = shift;
|
my $test = shift;
|
||||||
my $session = $test->session;
|
my $session = $test->session;
|
||||||
note "uiLevel";
|
note "uiLevel";
|
||||||
|
|
@ -173,7 +230,7 @@ sub uiLevel : Test(1) {
|
||||||
is $asset->uiLevel, $test->assetUiLevel, 'asset uiLevel check';
|
is $asset->uiLevel, $test->assetUiLevel, 'asset uiLevel check';
|
||||||
}
|
}
|
||||||
|
|
||||||
sub write_update : Test(8) {
|
sub t_01_write_update : Test(8) {
|
||||||
my $test = shift;
|
my $test = shift;
|
||||||
my $session = $test->session;
|
my $session = $test->session;
|
||||||
note "write, update";
|
note "write, update";
|
||||||
|
|
@ -210,89 +267,7 @@ sub write_update : Test(8) {
|
||||||
$session->db->write("delete from assetData where assetId=?", [$testId]);
|
$session->db->write("delete from assetData where assetId=?", [$testId]);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub keywords : Test(3) {
|
sub t_03_addRevision : Test(5) {
|
||||||
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) {
|
|
||||||
note "cut";
|
note "cut";
|
||||||
my $test = shift;
|
my $test = shift;
|
||||||
my $session = $test->session;
|
my $session = $test->session;
|
||||||
|
|
@ -308,6 +283,46 @@ sub cut_paste : Test(5) {
|
||||||
$session->asset($session_asset);
|
$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;
|
1;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue