Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

specific test for array data migration

  • Loading branch information...
commit 46f0235aeb76b6651a1ef3f12f3c67fac5d78a9e 1 parent e99f5ad
@dod38fr authored
Showing with 91 additions and 0 deletions.
  1. +91 −0 config-model-core/t/array_with_data_migration.t
View
91 config-model-core/t/array_with_data_migration.t
@@ -0,0 +1,91 @@
+# -*- cperl -*-
+
+use warnings FATAL => qw(all);
+
+use ExtUtils::testlib;
+use Test::More;
+use Test::Exception;
+use Test::Warn ;
+use Test::Differences ;
+use Test::Memory::Cycle;
+use Config::Model;
+use Log::Log4perl qw(:easy :levels) ;
+
+BEGIN { plan tests => 8; }
+
+use strict;
+
+my $arg = shift || '';
+
+my $log = 0 ;
+
+my $trace = $arg =~ /t/ ? 1 : 0 ;
+$log = 1 if $arg =~ /l/;
+
+my $home = $ENV{HOME} || "";
+my $log4perl_user_conf_file = "$home/.log4config-model";
+
+if ($log and -e $log4perl_user_conf_file ) {
+ Log::Log4perl::init($log4perl_user_conf_file);
+}
+else {
+ Log::Log4perl->easy_init($log ? $WARN: $ERROR);
+}
+
+my $model = Config::Model -> new ( ) ;
+
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+ok(1,"compiled");
+
+# minimal set up to get things working
+$model->create_config_class(
+ name => "Master",
+ element => [
+ plain_list => {
+ type => 'list',
+ cargo => {
+ type => 'leaf',
+ value_type => 'string'
+ },
+ },
+ list_with_data_migration => {
+ type => 'list',
+ migrate_keys_from => '- plain_list',
+ cargo => {
+ type => 'leaf',
+ value_type => 'string' ,
+ migrate_from => {
+ variables => { old => '- plain_list:&index'} ,
+ formula => '$old' ,
+ }
+ },
+ },
+ ]
+);
+
+ok(1,"config classes created") ;
+
+my $inst = $model->instance(
+ root_class_name => 'Master',
+ instance_name => 'test1'
+);
+ok( $inst, "created dummy instance" );
+$inst->initial_load_stop ;
+
+my $root = $inst->config_root;
+
+
+# test data migration stuff
+my $pl = $root->fetch_element('plain_list');
+$pl->push(qw/foo bar baz/) ;
+my @old = $pl->fetch_all_values ;
+ok(1,"set up plain list]") ;
+
+my $lwdm = $root->fetch_element('list_with_data_migration') ;
+ok($lwdm, "create list_with_data_migration element") ;
+
+eq_or_diff([$lwdm->fetch_all_indexes],[ 0 ..2 ],"test data migration size before actual migration") ;
+eq_or_diff([$lwdm->fetch_all_values], \@old,"test list data migration (@old)") ;
+
+memory_cycle_ok($model,"test memory cycles");
Please sign in to comment.
Something went wrong with that request. Please try again.