Clone stopped working in several tests in 5.14.2. Remove it in favor of Storable::dclone.

Clone handles being passed scalar data, but dclone does not.
This commit is contained in:
Colin Kuskie 2012-10-23 10:00:53 -07:00
parent 1b4f7c33fa
commit be37f12ab1
23 changed files with 70 additions and 49 deletions

View file

@ -89,7 +89,7 @@ ok( !$posts->[0]->{'user.isVisitor'}, 'first post made by visitor');
ok( $posts->[0]->{'hideProfileUrl'}, 'hide profile url, and user is visitor');
ok( !$posts->[0]->{'lastReply.user.isVisitor'}, 'lastReply not made by visitor');
ok( $posts->[0]->{'lastReply.hideProfileUrl'}, 'lastReply hide profile url, since user is visitor');
is( $posts->[0]->{'lastReply.url'}, $threads[1]->getUrl.'?pn=1#id'.$threads[1]->getId, 'lastReply url has a query fragment prefixed by "id"');
is( $posts->[0]->{'lastReply.url'}, $threads[1]->getUrl.'#id'.$threads[1]->getId, 'lastReply url has a query fragment prefixed by "id"');
is( $posts->[0]->{'url'}, $threads[1]->getUrl.'#id'.$threads[1]->getId, 'url has a query fragment prefixed by "id"');

View file

@ -13,7 +13,7 @@ use Data::Dumper;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use JSON;
use Clone qw/clone/;
use Storable qw/dclone/;
#----------------------------------------------------------------------------
# Init
@ -2112,13 +2112,13 @@ sub buildSectionSkeleton {
my $sections = [];
my ($bareSection, $bareQuestion, $bareAnswer) = getBareSkeletons();
foreach my $questionSpec ( @{ $spec } ) {
my $section = clone $bareSection;
my $section = dclone $bareSection;
push @{ $sections }, $section;
foreach my $answers ( @{$questionSpec} ) {
my $question = clone $bareQuestion;
my $question = dclone $bareQuestion;
push @{ $section->{questions} }, $question;
while ($answers-- > 0) {
my $answer = clone $bareAnswer;
my $answer = dclone $bareAnswer;
push @{ $question->{answers} }, $answer;
}
}

View file

@ -13,7 +13,6 @@ use Data::Dumper;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use JSON;
use Clone qw/clone/;
#----------------------------------------------------------------------------
# Init

View file

@ -9,7 +9,7 @@ use lib "$FindBin::Bin/../../../lib";
use Test::More;
use Test::Deep;
use Data::Dumper;
use Clone qw/clone/;
use Storable qw/dclone/;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
WebGUI::Error->Trace(1); # Turn on tracing of uncaught Exception::Class exceptions
@ -52,7 +52,7 @@ ok exists $asset_data->{question_types}->{toes}, 'the toes type in a question ty
explain $asset_data;
ok !exists $asset_data->{question_types}->{name}, 'name question not in question types';
$asset_data->{question_types}->{fingers} = clone $asset_data->{question_types}->{toes};
$asset_data->{question_types}->{fingers} = $asset_data->{question_types}->{toes};
$survey->importAssetCollateralData($asset_data);

View file

@ -19,7 +19,7 @@ use strict;
use lib "$FindBin::Bin/../../lib";
use Test::More;
use Test::Deep;
use Clone qw/clone/;
use Storable qw/dclone/;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
@ -64,7 +64,7 @@ my $templateMock = Test::MockObject->new({});
$templateMock->set_isa('WebGUI::Asset::Template');
$templateMock->set_always('getId', $templateId);
my $templateVars;
$templateMock->mock('process', sub { $templateVars = clone $_[1]; } );
$templateMock->mock('process', sub { $templateVars = dclone $_[1]; } );
my $asset = $node->addChild( {
className => 'WebGUI::Asset::Wobject::WeatherData',

View file

@ -18,7 +18,7 @@ use WebGUI::Asset;
use Test::More;
use Test::Deep;
use Clone qw/clone/;
use Storable qw/dclone/;
plan tests => 1;
@ -37,7 +37,7 @@ my $templateMock = Test::MockObject->new({});
$templateMock->set_isa('WebGUI::Asset::Template');
$templateMock->set_always('getId', $templateId);
my $templateVars;
$templateMock->mock('process', sub { $templateVars = clone($_[1]); } );
$templateMock->mock('process', sub { $templateVars = dclone($_[1]); } );
$session->setting->set('userFunctionStyleId', $templateId);
##Have to have a user who can add assets to the root node

View file

@ -18,7 +18,7 @@ use WebGUI::Asset;
use Test::More;
use Test::Deep;
use Clone qw/clone/;
use Storable qw/dclone/;
plan tests => 1;
@ -39,7 +39,7 @@ my $templateMock = Test::MockObject->new({});
$templateMock->set_isa('WebGUI::Asset::Template');
$templateMock->set_always('getId', $templateId);
my $templateVars;
$templateMock->mock('process', sub { $templateVars = clone($_[1]); } );
$templateMock->mock('process', sub { $templateVars = dclone($_[1]); } );
{
WebGUI::Test->mockAssetId($templateId, $templateMock);

View file

@ -396,7 +396,7 @@ cmp_ok($expirationDate-time(), '>', 50, 'checking expire offset override on addU
$session->db->dbh->do('DROP TABLE IF EXISTS myUserTable');
WebGUI::Test->addToCleanup(SQL => 'DROP TABLE IF EXISTS myUserTable');
$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) TYPE=InnoDB!);
$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) ENGINE=InnoDB!);
my $sth = $session->db->prepare('INSERT INTO myUserTable VALUES(?)');
foreach my $mob (@mob) {

View file

@ -49,7 +49,7 @@ is($output, 'Group Not a Group was not found', 'Non-existant group returns an er
##Create a small database
$session->db->dbh->do('DROP TABLE IF EXISTS myUserTable');
$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) TYPE=InnoDB!);
$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) Engine=InnoDB!);
WebGUI::Test->addToCleanup(SQL => 'DROP TABLE IF EXISTS myUserTable');
##Create a bunch of users and put them in the table.

View file

@ -33,7 +33,7 @@ my $originalMacroAccessValue = $WebGUIdbLink->macroAccessIsAllowed();
$session->db->dbh->do('DROP TABLE IF EXISTS testTable');
WebGUI::Test->addToCleanup(SQL => 'DROP TABLE testTable');
$session->db->dbh->do('CREATE TABLE testTable (zero int(8), one int(8), two int(8), three int(8), four int(8), five int(8), six int(8), seven int(8), eight int(8), nine int(8), ten int(8), eleven int(8) ) TYPE=InnoDB');
$session->db->dbh->do('CREATE TABLE testTable (zero int(8), one int(8), two int(8), three int(8), four int(8), five int(8), six int(8), seven int(8), eight int(8), nine int(8), ten int(8), eleven int(8) ) ENGINE=InnoDB');
$session->db->dbh->do('INSERT INTO testTable (zero, one, two, three, four, five, six, seven, eight, nine, ten, eleven ) VALUES(0,1,2,3,4,5,6,7,8,9,10,11)');
$session->db->dbh->do('INSERT INTO testTable (zero, one, two, three, four, five, six, seven, eight, nine, ten, eleven ) VALUES(100,101,102,103,104,105,106,107,108,109,110,111)');

View file

@ -173,7 +173,7 @@ SKIP: {
skip("No InnoDB tables in this MySQL. Skipping all transaction related tests.",7) if (lc $mysqlVariables{have_innodb} ne 'yes');
$session->db->dbh->do('DROP TABLE IF EXISTS testTable');
$session->db->dbh->do('CREATE TABLE testTable (myIndex int(8) NOT NULL default 0, message CHAR(64), PRIMARY KEY(myIndex)) TYPE=InnoDB');
$session->db->dbh->do('CREATE TABLE testTable (myIndex int(8) NOT NULL default 0, message CHAR(64), PRIMARY KEY(myIndex)) Engine=InnoDB');
addToCleanup( SQL => 'DROP TABLE testTable' );
my $dbh2 = WebGUI::SQL->connect($session,$session->config->get("dsn"), $session->config->get("dbuser"), $session->config->get("dbpass"));

View file

@ -23,7 +23,7 @@ use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use WebGUI::Shop::Transaction;
use WebGUI::Inbox;
use Clone qw/clone/;
use Storable qw/dclone/;
#----------------------------------------------------------------------------
# Init
@ -269,7 +269,7 @@ my $templateMock = Test::MockObject->new({});
$templateMock->set_isa('WebGUI::Asset::Template');
$templateMock->set_always('getId', $templateId);
my @templateVars;
$templateMock->mock('process', sub { push @templateVars, clone $_[1]; } );
$templateMock->mock('process', sub { push @templateVars, dclone $_[1]; } );
$session->setting->set('shopReceiptEmailTemplateId', $templateId);

View file

@ -29,7 +29,7 @@ use base qw(Test::Builder::Module);
use Test::MockObject;
use Test::MockObject::Extends;
use Log::Log4perl; # load early to ensure proper order of END blocks
use Clone qw(clone);
use Storable qw(dclone);
use File::Basename qw(dirname fileparse);
use File::Spec::Functions qw(abs2rel rel2abs catdir catfile updir);
use IO::Handle ();
@ -108,7 +108,7 @@ sub import {
sub _initSession {
my $session = our $SESSION = $CLASS->newSession(1);
my $originalSetting = clone $session->setting->get;
my $originalSetting = dclone $session->setting->get;
$CLASS->addToCleanup(sub {
while (my ($param, $value) = each %{ $originalSetting }) {
$session->setting->set($param, $value);
@ -612,7 +612,7 @@ sub originalConfig {
my ($class, $param) = @_;
my $safeValue = my $value = $CLASS->session->config->get($param);
if (ref $value) {
$safeValue = clone $value;
$safeValue = dclone $value;
}
# add cleanup handler if this is the first time we were run
if (! keys %originalConfig) {