Numerous corrections to tests.
Currently, "Looks like you failed 62 tests of 3882". Many transient, non-deterministic failures lurk and specific asset types need special cases added in test subclasses.
This commit is contained in:
Scott Walters
parent
d57d9ff962
commit
7eda8f7d46
1 changed files with 187 additions and 27 deletions
|
|
@ -8,6 +8,10 @@ package Test::WebGUI::Asset;
|
|||
#-------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use base qw/My::Test::Class/;
|
||||
|
||||
use Test::More;
|
||||
|
|
@ -17,6 +21,28 @@ use WebGUI::Test;
|
|||
use WebGUI::Utility;
|
||||
use Data::Dumper;
|
||||
|
||||
sub debug {
|
||||
|
||||
# if the last eval { } caught something, give full diagnostics on that and stop the tests.
|
||||
# while working through these bugs in here, it does no good to run the test suite until completion after something blows up.
|
||||
|
||||
my $e = Exception::Class->caught() or return;
|
||||
my $line = (caller)[2];
|
||||
|
||||
if( Scalar::Util::blessed( $e ) ) {
|
||||
note( $line . ': ' . $e->error . "\n" . $e->full_message . "\n" . $e->trace->as_string );
|
||||
} else {
|
||||
note( $line . ': ' . "\n(non-object error:) $e" );
|
||||
}
|
||||
|
||||
return; # XXX enable/disable aborting tests on failure
|
||||
|
||||
warn "going to exit in ... a whole bunch... of seconds";
|
||||
sleep 10;
|
||||
# system 'sleep 6000'; # sleep 10; # this way, we can control-c it!
|
||||
exit;
|
||||
}
|
||||
|
||||
sub assetUiLevel {
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -29,6 +55,29 @@ sub parent_list {
|
|||
return [];
|
||||
}
|
||||
|
||||
sub flattenFormObjects {
|
||||
my $arr = shift;
|
||||
my @result;
|
||||
my @no_arrays = map { (ref $_ eq 'ARRAY') ? flattenFormObjects($_) : $_ } @$arr;
|
||||
for my $formob (@no_arrays) {
|
||||
if($formob->get('buttons')) {
|
||||
push @result, flattenFormObjects( $formob->get('buttons') );
|
||||
} else {
|
||||
push @result, $formob;
|
||||
}
|
||||
}
|
||||
@result;
|
||||
}
|
||||
|
||||
sub formProperties {
|
||||
my $asset = shift;
|
||||
my %properties =
|
||||
map { ( $_ => $asset->get($_) ) }
|
||||
# map { [ $_ => $asset->getFormProperties($_) ] }
|
||||
grep { ! $asset->meta->find_attribute_by_name( $_ )->noFormPost } $asset->getProperties;
|
||||
return %properties;
|
||||
}
|
||||
|
||||
sub getAnchoredAsset {
|
||||
my $test = shift;
|
||||
my $session = $test->session;
|
||||
|
|
@ -37,6 +86,7 @@ sub getAnchoredAsset {
|
|||
my $asset = $parents[-1]->addChild({
|
||||
className => $test->class,
|
||||
}, undef, undef, {skipNotification => 1, skipAutoCommitWorkflows => 1,});
|
||||
# warn "XXX getAnchoredAsset: created new asset of Id: " . $asset->getId . ' of type: ' . ref $asset;
|
||||
$tag->commit;
|
||||
foreach my $a ($asset, @parents) {
|
||||
$a = $a->cloneFromDb;
|
||||
|
|
@ -53,7 +103,7 @@ sub getMyParents {
|
|||
my $default = WebGUI::Asset->getDefault($session);
|
||||
push @parents, $default;
|
||||
my $parent = $default;
|
||||
foreach $parent_class (@{ $parent_classes }) {
|
||||
foreach my $parent_class (@{ $parent_classes }) {
|
||||
my $new_parent = $parent->addChild({className => $parent_class}, undef, undef, {skipNotification => 1, skipAutoCommitWorkflows => 1,});
|
||||
push @parents, $new_parent;
|
||||
$parent = $new_parent;
|
||||
|
|
@ -67,14 +117,19 @@ sub _constructor : Test(4) {
|
|||
my $session = $test->session;
|
||||
my $asset = $test->class->new({session => $session});
|
||||
|
||||
isa_ok $asset, $test->class;
|
||||
isa_ok $asset->session, 'WebGUI::Session';
|
||||
note '=' x 80;
|
||||
note "Constructor: CLASS " . $test->class;
|
||||
note '=' x 80;
|
||||
|
||||
isa_ok $asset, $test->class, "asset we created isa ``@{[ $test->class ]}''";
|
||||
isa_ok $asset->session, 'WebGUI::Session', "the session @{[ $test->class ]} we created isa WebGUI::Session";
|
||||
is $asset->session->getId, $session->getId, 'asset was assigned the correct session';
|
||||
|
||||
note "calling new with no assetId throws an exception";
|
||||
$asset = eval { WebGUI::Asset->new($session, ''); };
|
||||
my $e = Exception::Class->caught;
|
||||
isa_ok $e, 'WebGUI::Error';
|
||||
undef $@;
|
||||
|
||||
}
|
||||
|
||||
|
|
@ -82,7 +137,7 @@ 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 = $test->class->new({session => $session});
|
||||
|
||||
my $asset = WebGUI::Asset->new({
|
||||
session => $session,
|
||||
|
|
@ -92,6 +147,9 @@ sub t_00_class_dispatch : Test(2) {
|
|||
|
||||
isa_ok $asset, 'WebGUI::Asset';
|
||||
is $asset->className, 'WebGUI::Asset', 'passing className is ignored';
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_00_get_tables : Test(1) {
|
||||
|
|
@ -103,6 +161,9 @@ sub t_00_get_tables : Test(1) {
|
|||
$test->list_of_tables,
|
||||
'Set of tables for properties is correct'
|
||||
);
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_00_getParent : Test(2) {
|
||||
|
|
@ -127,6 +188,9 @@ sub t_00_getParent : Test(2) {
|
|||
|
||||
$session->db->write("delete from asset where assetId like 'wg8TestAsset00000%'");
|
||||
$session->db->write("delete from assetData where assetId like 'wg8TestAsset00000%'");
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_00_newByPropertyHashRef : Test(2) {
|
||||
|
|
@ -137,6 +201,9 @@ sub t_00_newByPropertyHashRef : Test(2) {
|
|||
$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';
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_00_scan_properties : Test(1) {
|
||||
|
|
@ -149,6 +216,9 @@ sub t_00_scan_properties : Test(1) {
|
|||
}
|
||||
ok !@undefined_tables, "all properties have tables defined"
|
||||
or diag "except these: ".join ", ", @undefined_tables;
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_01_assetId : Test(4) {
|
||||
|
|
@ -162,6 +232,9 @@ sub t_01_assetId : Test(4) {
|
|||
|
||||
$asset = $test->class->new({ session => $session, assetId => '' });
|
||||
ok !$session->id->valid($asset->assetId), 'blank assetId in constructor is okay??';
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_01_title : Test(6) {
|
||||
|
|
@ -184,6 +257,8 @@ sub t_01_title : Test(6) {
|
|||
|
||||
#is $asset->get('title'), $asset->title, '... get(title) works';
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_01_menuTitle : Test(8) {
|
||||
|
|
@ -220,6 +295,9 @@ sub t_01_menuTitle : Test(8) {
|
|||
menuTitle => 'menuTitle asset',
|
||||
});
|
||||
is $asset->menuTitle, 'menuTitle asset', '... set via constructor';
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_01_uiLevel : Test(1) {
|
||||
|
|
@ -228,6 +306,9 @@ sub t_01_uiLevel : Test(1) {
|
|||
note "uiLevel";
|
||||
my $asset = $test->class->new({session => $session});
|
||||
is $asset->uiLevel, $test->assetUiLevel, 'asset uiLevel check';
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_01_write_update : Test(8) {
|
||||
|
|
@ -265,6 +346,9 @@ sub t_01_write_update : Test(8) {
|
|||
|
||||
$session->db->write("delete from asset where assetId=?", [$testId]);
|
||||
$session->db->write("delete from assetData where assetId=?", [$testId]);
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_05_cut_paste : Test(5) {
|
||||
|
|
@ -276,11 +360,19 @@ sub t_05_cut_paste : Test(5) {
|
|||
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;
|
||||
ok eval { $asset->canPaste }, 'canPaste: allowed to paste here';
|
||||
debug($@);
|
||||
undef $@;
|
||||
ok eval { $parents[-1]->paste($asset->assetId) }, 'paste returns true when it pastes';
|
||||
debug($@);
|
||||
undef $@;
|
||||
my $asset_prime = eval { $asset->cloneFromDb };
|
||||
debug($@);
|
||||
undef $@;
|
||||
is $asset_prime->state, 'published', 'asset state updated';
|
||||
$session->asset($session_asset);
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_05_keywords : Test(3) {
|
||||
|
|
@ -291,6 +383,8 @@ sub t_05_keywords : Test(3) {
|
|||
$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';
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_05_purge : Test(3) {
|
||||
|
|
@ -300,12 +394,15 @@ sub t_05_purge : Test(3) {
|
|||
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';
|
||||
throws_ok { WebGUI::Asset->newById($session, $asset->assetId); } 'WebGUI::Error::InvalidParam', 'Unable to fetch asset by assetId now';
|
||||
undef $@; # or else Test::Class barfs
|
||||
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';
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_10_addRevision : Tests {
|
||||
|
|
@ -319,9 +416,11 @@ sub t_10_addRevision : Tests {
|
|||
isa_ok( $newRevision, Scalar::Util::blessed( $asset ), "addRevision returns new revision of asset object" );
|
||||
is( $newRevision->title, "Newly Revised Title", "properties set correctly" );
|
||||
is( $newRevision->revisionDate, $asset->revisionDate+2, 'revisionDate set correctly' );
|
||||
is( $newRevision->tagId, $tag->getId, "Added to existing working tag" );
|
||||
is( $newRevision->tagId, $tag->getId, "Added to existing working tag" ); # XXX failing for WebGUI::Asset::MapPoint
|
||||
|
||||
$newRevision->purgeRevision;
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
sub t_11_getEditForm : Tests {
|
||||
|
|
@ -336,7 +435,7 @@ sub t_11_getEditForm : Tests {
|
|||
|
||||
# assetId, className, keywords
|
||||
isa_ok( $f->getTab('meta')->getField('assetId'), 'WebGUI::Form::Guid' );
|
||||
isa_ok( $f->getTab('meta')->getField('class'), 'WebGUI::Form::ClassName' );
|
||||
isa_ok( $f->getTab('meta')->getField('className'), 'WebGUI::Form::ClassName' );
|
||||
isa_ok( $f->getTab('meta')->getField('keywords'), 'WebGUI::Form::Keywords' );
|
||||
|
||||
# Tabs
|
||||
|
|
@ -345,22 +444,60 @@ sub t_11_getEditForm : Tests {
|
|||
isa_ok( $f->getTab('security'), 'WebGUI::FormBuilder::Tab' );
|
||||
isa_ok( $f->getTab('meta'), 'WebGUI::FormBuilder::Tab' );
|
||||
|
||||
# Properties
|
||||
my $properties = map { !$asset->meta->find_attribute_by_name( $_ )->noFormPost } $asset->getProperties;
|
||||
use Data::Dumper;
|
||||
note( Dumper $f->getFieldsRecursive );
|
||||
exit;
|
||||
cmp_deeply(
|
||||
$f->getFieldsRecursive,
|
||||
bag( map { superhashof( $asset->getFormProperties( $_ ) ) } @$properties ),
|
||||
);
|
||||
|
||||
# Metadata
|
||||
|
||||
# Property overrides
|
||||
|
||||
ok( !$f->getField('func'), 'form must not contain "func"' );
|
||||
|
||||
# Properties
|
||||
use Data::Dumper;
|
||||
|
||||
# note( "f: " . Dumper $f->getFieldsRecursive );
|
||||
|
||||
# $asset->getProperties vs $asset->getEditForm->getFieldsRecursive
|
||||
|
||||
my @properties = grep { ! $asset->meta->find_attribute_by_name( $_ )->noFormPost } $asset->getProperties;
|
||||
@properties = map { $asset->getFormProperties($_) } @properties;
|
||||
|
||||
my @form = flattenFormObjects($f->getFieldsRecursive); # mixture of arrays of Form objects and arrays-of-arrays of them; flatten it out
|
||||
@form = map $_->{_params}, @form; # hash with label, uiLevel, hoverHelp, tab, etc fields in it # XXX API method rather than peeking
|
||||
|
||||
# Missing: 40 references
|
||||
# Extra: 28 references
|
||||
# cmp_deeply(
|
||||
# [ map { $asset->getFormProperties($_) } @properties ],
|
||||
# bag( map { superhashof($_) } @form ),
|
||||
# 'getProperties agrees with getEditForm->getFieldsRecursive',
|
||||
# );
|
||||
|
||||
# Missing: 25 references
|
||||
# Extra: 37 references
|
||||
# cmp_deeply(
|
||||
# \@form,
|
||||
# bag( map { superhashof($asset->getFormProperties($_)) } @properties ),
|
||||
# 'getProperties agrees with getEditForm->getFieldsRecursive',
|
||||
# );
|
||||
|
||||
my %superlist = map { ( $_->{label} => 1 ) } grep { $_->{label} } @form, @properties;
|
||||
note "all labels: " . join ', ', keys %superlist;
|
||||
|
||||
for my $label (keys %superlist) {
|
||||
no warnings 'uninitialized';
|
||||
note "label ``$label'' not in properties" if ! grep { $_->{label} eq $label } @properties;
|
||||
note "label ``$label'' not in form" if ! grep { $_->{label} eq $label } @form;
|
||||
}
|
||||
|
||||
@form = grep { defined $_->{label} and $_->{label} ne 'Keywords' and $_->{label} ne 'Class Name' and $_->{label} ne 'Asset ID' } @form;
|
||||
|
||||
cmp_deeply(
|
||||
[ sort { $a cmp $b } map { $_->{label} } @form ],
|
||||
[ sort { $a cmp $b } map { $_->{label} } @properties ],
|
||||
'getProperties agrees with getEditForm->getFieldsRecursive',
|
||||
);
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
|
||||
}
|
||||
|
||||
sub t_20_www_editSave : Tests {
|
||||
|
|
@ -374,22 +511,45 @@ sub t_20_www_editSave : Tests {
|
|||
$asset->groupIdEdit( 7 ); # Everybody! Everybody!
|
||||
|
||||
$tag->setWorking;
|
||||
$session->request->setup_body({
|
||||
title => "Newly Saved Title",
|
||||
});
|
||||
$asset->www_editSave;
|
||||
|
||||
# $tag = WebGUI::VersionTag->create($session, {}); $tag->setWorking; # XXXXXX
|
||||
sleep 2; # also XXXX
|
||||
|
||||
# warn "XXX formProperties: " . Dumper [ formProperties($asset) ];
|
||||
|
||||
my %mergedProperties = (
|
||||
formProperties($asset),
|
||||
title => "Newly Saved Title",
|
||||
);
|
||||
|
||||
$session->request->setup_body( \%mergedProperties );
|
||||
|
||||
ok(eval { $asset->www_editSave; }, 'www_editSave returns true'); # "DBD::mysql::db do failed: Duplicate entry ... for key 'PRIMARY' [for Statement "insert into assetData (assetId,revisionDate) values (?,?)"]" ... getting ready to insert into tables... assetId is: dinQXqxuUyrO0DmooZe4bg at /data/WebGUI/lib/WebGUI/AssetVersioning.pm line 123. XXX does that sleep 2 actually fix this or did I imagine that?
|
||||
debug($@);
|
||||
undef $@;
|
||||
|
||||
# Get the newly-created revision of the asset
|
||||
my $newRevision = WebGUI::Asset->newPending( $session, $asset->getId );
|
||||
ok( my $newRevision = eval { WebGUI::Asset->newPending( $session, $asset->getId ); }, 'newPending returns true' );
|
||||
debug($@);
|
||||
undef $@;
|
||||
|
||||
ok( $newRevision->tagId, 'new revision has a tag' );
|
||||
is( $newRevision->tagId, $tag->getId, 'new revision tagId is current working tag' );
|
||||
|
||||
if( $mergedProperties{templateId} ) {
|
||||
is( $newRevision->templateId, $mergedProperties{templateId}, 'new revision has the corret templateId' );
|
||||
}
|
||||
|
||||
# Alter permissions so it does not work
|
||||
# XXX todo?
|
||||
|
||||
# Set locked so it does not work
|
||||
# XXX todo?
|
||||
|
||||
$asset->groupIdEdit( $oldGroupId );
|
||||
eval { $asset->groupIdEdit( $oldGroupId ); };
|
||||
|
||||
debug($@);
|
||||
undef $@;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue