Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: dod38fr/config-model
base: 46f0235aeb
...
head fork: dod38fr/config-model
compare: 37b361aaa9
  • 14 commits
  • 15 files changed
  • 0 commit comments
  • 1 contributor
View
23 config-model-core/ChangeLog
@@ -1,3 +1,26 @@
+2012-05-14 Dominique Dumont <domi.dumont@free.fr> 2.015
+
+ * Application changes:
+ * Copyright model: replace migrate_keys_from with new
+ migrate_values_from. This simplifies the model
+
+ * Framework changes:
+ + List or Hash: added migrate_values_from to enable migration
+ from another hash or list. migrate_keys_from for list element
+ is now deprecated.
+ * List, Hash, Value: ensure that migration is done after initial
+ load, i.e. once all data from configuration file is loaded.
+ * AnyId, List, Hash: deprecated get_all_indexes in favor of
+ fetch_all_indexes
+ * Value:
+ * make sure that setting a default value triggers
+ notify_change so the resulting modification in the
+ config file can be saved
+ * don't trigger notify_change with update undef -> undef
+
+ * Test changes:
+ * Tester: added file_contents_like and file_contents_unlike tests
+
2012-05-03 Dominique Dumont <domi.dumont@free.fr> 2.014
* Application changes:
View
2  config-model-core/dist.ini
@@ -1,5 +1,5 @@
name = Config-Model
-version = 2.014
+version = 2.015
author = Dominique Dumont
author = Krzysztof Tyszecki
license = LGPL_2_1
View
39 config-model-core/lib/Config/Model/AnyId.pm
@@ -46,7 +46,8 @@ has \@common_hash_params => (is => 'ro', isa => 'Maybe[HashRef]') ;
my @common_list_params = qw/allow_keys default_keys auto_create_keys/;
has \@common_list_params => (is => 'ro', isa => 'Maybe[ArrayRef]') ;
-my @common_str_params = qw/allow_keys_from allow_keys_matching follow_keys_from migrate_keys_from
+my @common_str_params = qw/allow_keys_from allow_keys_matching follow_keys_from
+ migrate_keys_from migrate_values_from
duplicates warn_if_key_match warn_unless_key_match/;
has \@common_str_params => (is => 'ro', isa => 'Maybe[Str]') ;
@@ -623,32 +624,19 @@ sub check_duplicates {
}
}
-sub _migrate_keys {
- my $self = shift;
-
- return if $self->{migration_done};
- $self->{migration_done} = 1;
-
- return unless $self->{migrate_keys_from} ;
-
- my $followed = $self->safe_typed_grab(param => 'migrate_keys_from', check => 'no') ;
- if ($logger->is_debug) {
- $logger ->debug($self->name," migrate keys from ",$followed->name);
- }
- map { $self->_store($_, undef) unless $self->_defined($_) } $followed -> fetch_all_indexes ;
-}
-
sub fetch_with_id {
my $self = shift ;
my %args = @_ > 1 ? @_ : ( index => shift ) ;
my $check = $self->_check_check($args{check}) ;
my $idx = $args{index} ;
+ $logger->debug($self->name," called for idx $idx") if $logger->is_debug ;
+
$idx = $self->{convert_sub}($idx)
if (defined $self->{convert_sub} and defined $idx) ;
# try migration only once
- $self->_migrate_keys unless $self->{migration_done};
+ $self->_migrate unless $self->{migration_done};
my $ok = 1 ;
# check index only if it's unknown
@@ -781,7 +769,7 @@ sub fetch_all_values {
sub fetch_all_indexes {
my $self = shift;
$self->create_default ; # will check itself if creation is necessary
- $self->_migrate_keys ;
+ $self->_migrate ;
return $self->_fetch_all_indexes ;
}
@@ -1152,10 +1140,19 @@ When the hash contains leaves, you can also use:
=item migrate_keys_from
-Specifies that the keys of the hash or list are copied from another hash or list in
-the configuration tree only when the hash is created.
+Specifies that the keys of the hash are copied from another hash in
+the configuration tree only when the hash is read for the first time after
+initial load (i.e. once the configuration files are completely read).
+
+ migrate_keys_from => '- another_hash'
+
+=item migrate_values_from
+
+Specifies that the values of the hash (or list) are copied from another hash (or list) in
+the configuration tree only when the hash (or list) is read for the first time after
+initial load (i.e. once the configuration files are completely read).
- migrate_keys_from => '- another_hash_or_list'
+ migrate_values_from => '- another_hash_or_list'
=item follow_keys_from
View
36 config-model-core/lib/Config/Model/HashId.pm
@@ -20,6 +20,13 @@ has [qw/morph ordered/] => (is => 'ro', isa => 'Bool' ) ;
sub BUILD {
my $self = shift;
+ # foreach my $wrong (qw/migrate_values_from/) {
+ # Config::Model::Exception::Model->throw (
+ # object => $self,
+ # error => "Cannot use $wrong with ".$self->get_type." element"
+ # ) if defined $self->{$wrong};
+ # }
+
# could use "required", but we'd get a Moose error instead of a Config::Model
# error
Config::Model::Exception::Model->throw
@@ -62,6 +69,35 @@ sub set_properties {
}
}
+sub _migrate {
+ my $self = shift;
+
+ return if $self->{migration_done};
+
+ # migration must be done *after* initial load to make sure that all data
+ # were retrieved from the file before migration.
+ return if $self->instance->initial_load ;
+ $self->{migration_done} = 1;
+
+ if ($self->{migrate_keys_from}) {
+ my $followed = $self->safe_typed_grab(param => 'migrate_keys_from', check => 'no') ;
+ if ($logger->is_debug) {
+ $logger ->debug($self->name," migrate keys from ",$followed->name);
+ }
+
+ map { $self->_store($_, undef) unless $self->_defined($_) } $followed -> fetch_all_indexes ;
+ }
+ elsif ( $self->{migrate_values_from}) {
+ my $followed = $self->safe_typed_grab(param => 'migrate_values_from', check => 'no') ;
+ $logger ->debug($self->name," migrate values from ",$followed->name) if $logger->is_debug;
+ foreach my $item ( $followed -> fetch_all_indexes ) {
+ next if $self->exists($item) ; # don't clobber existing entries
+ my $data = $followed->fetch_with_id($item) -> dump_as_data(check => 'no') ;
+ $self->fetch_with_id($item)->load_data($data) ;
+ }
+ }
+
+}
sub get_type {
my $self = shift;
View
36 config-model-core/lib/Config/Model/ListId.pm
@@ -20,13 +20,17 @@ sub BUILD {
my $self = shift;
foreach my $wrong (qw/max_nb min_index default_keys/) {
- Config::Model::Exception::Model->throw
- (
+ Config::Model::Exception::Model->throw (
object => $self,
error => "Cannot use $wrong with ".$self->get_type." element"
) if defined $self->{$wrong};
}
+ if (defined $self->{migrate_keys_from}) {
+ warn $self->name, "Using migrate_keys_from with list element is deprecated.",
+ " Use migrate_values_from\n" ;
+ }
+
# Supply the mandatory parameter
return $self;
}
@@ -51,6 +55,34 @@ sub set_properties {
}
}
+sub _migrate {
+ my $self = shift;
+
+ return if $self->{migration_done};
+
+ # migration must be done *after* initial load to make sure that all data
+ # were retrieved from the file before migration.
+ return if $self->instance->initial_load ;
+
+ $self->{migration_done} = 1;
+
+ if ( $self->{migrate_values_from}) {
+ my $followed = $self->safe_typed_grab(param => 'migrate_values_from', check => 'no') ;
+ $logger ->debug($self->name," migrate values from ",$followed->name) if $logger->is_debug;
+ my $idx = $self->fetch_size ;
+ foreach my $item ( $followed -> fetch_all_indexes ) {
+ my $data = $followed->fetch_with_id($item) -> dump_as_data(check => 'no') ;
+ $self->fetch_with_id( $idx++ )->load_data($data) ;
+ }
+ }
+ elsif ($self->{migrate_keys_from}) {
+ # FIXME: remove this deprecated stuff
+ my $followed = $self->safe_typed_grab(param => 'migrate_keys_from', check => 'no') ;
+ map { $self->_store($_, undef) unless $self->_defined($_) } $followed -> fetch_all_indexes ;
+ }
+
+
+}
sub get_type {
my $self = shift;
View
6 config-model-core/lib/Config/Model/Loader.pm
@@ -577,7 +577,7 @@ sub _load_list {
my ($self,$node, $check,$experience,$inst,$cmdref) = @_ ;
my ($element_name,$action,$id,$subaction,$value,$note) = @$inst ;
- my $element = $node -> fetch_element($element_name) ;
+ my $element = $node -> fetch_element(name => $element_name, check => $check) ;
my $elt_type = $node -> element_type( $element_name ) ;
my $cargo_type = $element->cargo_type ;
@@ -651,7 +651,7 @@ sub _load_hash {
my ($self,$node,$check,$experience,$inst,$cmdref) = @_ ;
my ($element_name,$action,$id,$subaction,$value,$note) = @$inst ;
- my $element = $node -> fetch_element($element_name) ;
+ my $element = $node -> fetch_element(name => $element_name, check => $check ) ;
my $cargo_type = $element->cargo_type ;
if (defined $note and not defined $action) {
@@ -749,7 +749,7 @@ sub _load_leaf {
my ($self,$node,$check,$experience,$inst,$cmdref) = @_ ;
my ($element_name,$action,$id,$subaction,$value,$note) = @$inst ;
- my $element = $node -> fetch_element($element_name) ;
+ my $element = $node -> fetch_element(name => $element_name, check => $check) ;
$self->_load_note($element, $note, $inst, $cmdref);
if (defined $action and $action eq '~' and $element->isa('Config::Model::Value')) {
View
25 config-model-core/lib/Config/Model/Tester.pm
@@ -36,7 +36,7 @@ sub setup_test {
rmtree($wr_root);
mkpath( $wr_root, { mode => 0755 } );
- my $wr_dir = $wr_root . '/test-' . $t_name;
+ my $wr_dir = $wr_root . '/test-' . $t_name.'/';
my $conf_file ;
$conf_file = "$wr_dir/$conf_dir/$conf_file_name" if defined $conf_file_name;
@@ -219,6 +219,18 @@ sub run_model_test {
}
}
+ if (my $fc = $t->{file_contents_like}) {
+ foreach my $f (keys %$fc) {
+ file_contents_like $wr_dir.$f, $fc->{$f}, "check that $f matches regexp";
+ }
+ }
+
+ if (my $fc = $t->{file_contents_unlike}) {
+ foreach my $f (keys %$fc) {
+ file_contents_unlike $wr_dir.$f, $fc->{$f}, "check that $f does not match regexp";
+ }
+ }
+
my @new_file_list;
if ( -d $ex_data ) {
@@ -233,7 +245,8 @@ sub run_model_test {
}
# create another instance to read the conf file that was just written
- my $wr_dir2 = $wr_dir . '-w';
+ my $wr_dir2 = $wr_dir ;
+ $wr_dir2 =~ s!/$!-w/!;
dircopy( $wr_dir, $wr_dir2 )
or die "can't copy from $wr_dir to $wr_dir2: $!";
@@ -526,6 +539,14 @@ Check the content of the written files(s) with L<Test::File::Contents>:
file_content => {
"/home/foo/my_arm.conf" => "really big string" ,
}
+
+ file_contents_like => {
+ "/home/foo/my_arm.conf" => qw/should be there/ ,
+ }
+
+ file_contents_unlike => {
+ "/home/foo/my_arm.conf" => qw/should NOT be there/ ,
+ }
=item *
View
29 config-model-core/lib/Config/Model/Value.pm
@@ -2,6 +2,7 @@ package Config::Model::Value ;
use Any::Moose;
use Any::Moose '::Util::TypeConstraints' ;
+use Any::Moose 'X::StrictConstructor' ;
use namespace::autoclean;
use Data::Dumper ();
@@ -281,7 +282,9 @@ sub set_migrate_from {
sub migrate_value {
my $self = shift ;
- my $i = $self->instance;
+ return if $self->{migration_done} ;
+ return if $self->instance->initial_load ;
+ $self->{migration_done} =1 ;
# avoid warning when reading deprecated values
my $result = $self->{_migrate_from} -> compute (check => 'no');
@@ -1039,8 +1042,8 @@ sub apply_fix {
}
$self->notify_change(
- old => $value // $self->_pre_fetch,
- new => $self->{data} // $self->_pre_fetch,
+ old => $value // $self->_fetch_std,
+ new => $self->{data} // $self->_fetch_std,
note => 'applied fix'
) ;
# $self->store(value => $_, check => 'no'); # will update $self->{fixes}
@@ -1136,8 +1139,8 @@ sub store {
no warnings 'uninitialized';
$self->notify_change(
check_done => 1,
- old => $self->{data} // $self->_pre_fetch,
- new => $value // $self->_pre_fetch
+ old => $self->{data} // $self->_fetch_std,
+ new => $value // $self->_fetch_std
) if $notify_change;
$self->{data} = $value ; # may be undef
}
@@ -1291,7 +1294,7 @@ sub fetch_custom {
sub fetch_standard {
my $self = shift ;
- my $pre_fetch = $self->_pre_fetch ;
+ my $pre_fetch = $self->_fetch_std ;
my $v = defined $pre_fetch ? $pre_fetch
: defined $self->{layered} ? $self->{layered}
: $self->compute_is_upstream_default ? $self->perform_compute
@@ -1315,7 +1318,7 @@ sub _init {
# returns something that needs to be written to config file
# unless overridden by user data
-sub _pre_fetch {
+sub _fetch_std {
my ($self, $mode, $check) = @_ ;
#$self->_init ;
@@ -1364,12 +1367,20 @@ sub _fetch {
$logger->debug("called for ".$self->location) if $logger->is_debug ;
# always call to perform submit_to_warp
- my $pref = $self->_pre_fetch($mode, $check) ;
+ my $pref = $self->_fetch_std($mode, $check) ;
+
+ my $data = $self->{data} ;
+ my $std_backup = $self->{_std_backup} ;
+ if (defined $pref
+ and (not defined $data or not defined $std_backup or $data ne $std_backup)) {
+ $self->{_std_backup} = $pref ;
+ $self->notify_change(old => $data // $std_backup, new => $pref, note => "use standard value") ;
+ }
+
my $known_upstream = defined $self->{layered} ? $self->{layered}
: $self->compute_is_upstream_default ? $self->perform_compute
: $self->{upstream_default} ;
my $std = defined $pref ? $pref : $known_upstream ;
- my $data = $self->{data} ;
if (not defined $data and defined $self->{_migrate_from}) {
$data = $self->migrate_value ;
View
16 config-model-core/lib/Config/Model/models/Debian/Dpkg/Copyright.pl
@@ -61,15 +61,9 @@
},
'Upstream-Contact',
{
- 'migrate_keys_from' => '- Upstream-Maintainer',
+ 'migrate_values_from' => '- Upstream-Maintainer',
'cargo' => {
'value_type' => 'uniline',
- 'migrate_from' => {
- 'formula' => '$maintainer',
- 'variables' => {
- 'maintainer' => '- Upstream-Maintainer:&index'
- }
- },
'type' => 'leaf'
},
'type' => 'list',
@@ -161,15 +155,9 @@
},
'Upstream-Maintainer',
{
- 'migrate_keys_from' => '- Maintainer',
+ 'migrate_values_from' => '- Maintainer',
'cargo' => {
'value_type' => 'uniline',
- 'migrate_from' => {
- 'formula' => '$maintainer',
- 'variables' => {
- 'maintainer' => '- Maintainer:&index'
- }
- },
'type' => 'leaf'
},
'status' => 'deprecated',
View
14 config-model-core/t/array_id.t
@@ -12,7 +12,7 @@ use Config::Model;
use Config::Model::AnyId;
use Log::Log4perl qw(:easy :levels) ;
-BEGIN { plan tests => 106; }
+BEGIN { plan tests => 105; }
use strict;
@@ -68,11 +68,6 @@ $model->create_config_class(
auto_create_ids => 4,
@element
},
- list_with_migrate_keys_from => {
- type => 'list',
- @element,
- migrate_keys_from => '- list_with_auto_created_id',
- },
olist => {
type => 'list',
cargo => {
@@ -325,13 +320,6 @@ eq_or_diff(
eq_or_diff( [ $pl->fetch_all_values( mode => 'custom' ) ],
['bar'], "check that custom values are read" );
-# test key migration
-my $lwmkf = $root->fetch_element('list_with_migrate_keys_from');
-my @to_migrate =
- $root->fetch_element('list_with_auto_created_id')->fetch_all_indexes;
-eq_or_diff( [ $lwmkf->fetch_all_indexes ],
- \@to_migrate, "check migrated ids (@to_migrate)" );
-
# test default_with_init on leaf
my $lwdwil = $root->fetch_element('list_with_default_with_init_leaf');
# note: calling fetch_all_indexes is required to trigger creation of default_with_init keys
View
44 config-model-core/t/array_with_data_migration.t
@@ -11,7 +11,7 @@ use Test::Memory::Cycle;
use Config::Model;
use Log::Log4perl qw(:easy :levels) ;
-BEGIN { plan tests => 8; }
+BEGIN { plan tests => 11; }
use strict;
@@ -44,6 +44,7 @@ $model->create_config_class(
element => [
plain_list => {
type => 'list',
+ status => 'deprecated' ,
cargo => {
type => 'leaf',
value_type => 'string'
@@ -51,14 +52,18 @@ $model->create_config_class(
},
list_with_data_migration => {
type => 'list',
- migrate_keys_from => '- plain_list',
+ migrate_values_from => '- plain_list',
+ cargo => {
+ type => 'leaf',
+ value_type => 'string' ,
+ },
+ },
+ list2_with_data_migration => {
+ type => 'list',
+ migrate_values_from => '- list_with_data_migration',
cargo => {
type => 'leaf',
value_type => 'string' ,
- migrate_from => {
- variables => { old => '- plain_list:&index'} ,
- formula => '$old' ,
- }
},
},
]
@@ -71,21 +76,32 @@ my $inst = $model->instance(
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/) ;
+# emulate config file load
+my $pl = $root->fetch_element(name => 'plain_list', check =>'no');
+$pl->push(qw/foo bar/) ;
my @old = $pl->fetch_all_values ;
-ok(1,"set up plain list]") ;
+ok(1,"set up plain list") ;
my $lwdm = $root->fetch_element('list_with_data_migration') ;
ok($lwdm, "create list_with_data_migration element") ;
+$lwdm->fetch_with_id(0)->store('baz0') ;
+
+# check data prior to migration
+eq_or_diff([$lwdm->fetch_all_values], ['baz0'],"list data before migration") ;
+
+# emulate end of file read
+$inst->initial_load_stop ;
+
+# test data migration stuff
+
+eq_or_diff([$lwdm->fetch_all_indexes],[ 0 ..2 ],"list size after migration") ;
+eq_or_diff([$lwdm->fetch_all_values], [ baz0 => @old],"list data migration (@old)") ;
-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)") ;
+my $lwdm2 = $root->fetch_element('list2_with_data_migration') ;
+ok($lwdm2, "create list2_with_data_migration element") ;
+eq_or_diff([$lwdm2->fetch_all_values], [ baz0 => @old ],"list2 data migration (@old)") ;
memory_cycle_ok($model,"test memory cycles");
View
111 config-model-core/t/hash_with_data_migration.t
@@ -0,0 +1,111 @@
+# -*- 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 => 11; }
+
+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_hash => {
+ type => 'hash',
+ status => 'deprecated' ,
+ index_type => 'string',
+ ordered => 1,
+ cargo => {
+ type => 'leaf',
+ value_type => 'string'
+ },
+ },
+ hash_with_data_migration => {
+ type => 'hash',
+ index_type => 'string',
+ migrate_values_from => '- plain_hash',
+ ordered => 1,
+ cargo => {
+ type => 'leaf',
+ value_type => 'string' ,
+ },
+ },
+ hash2_with_data_migration => {
+ type => 'hash',
+ index_type => 'string',
+ migrate_values_from => '- hash_with_data_migration',
+ ordered => 1,
+ cargo => {
+ type => 'leaf',
+ value_type => 'string' ,
+ },
+ },
+ ]
+);
+
+ok(1,"config classes created") ;
+
+my $inst = $model->instance(
+ root_class_name => 'Master',
+ instance_name => 'test1'
+);
+ok( $inst, "created dummy instance" );
+
+my $root = $inst->config_root;
+
+# emulate config file load
+$root->load(step => "plain_hash:k1=foo plain_hash:k2=bar", check => 'no') ;
+ok(1,"set up plain hash") ;
+
+my $hwdm = $root->fetch_element('hash_with_data_migration') ;
+ok($hwdm, "create hash_with_data_migration element") ;
+$hwdm->fetch_with_id('new')->store('baz0') ;
+
+# check data prior to migration
+eq_or_diff([$hwdm->fetch_all_values], ['baz0'],"hash data before migration") ;
+
+# emulate end of file read
+$inst->initial_load_stop ;
+
+# test data migration stuff
+
+eq_or_diff([$hwdm->fetch_all_indexes],[ qw/new k1 k2/ ],"hash keys after migration") ;
+eq_or_diff([$hwdm->fetch_all_values], [ qw/baz0 foo bar/],"hash data after migration ") ;
+
+my $hwdm2 = $root->fetch_element('hash2_with_data_migration') ;
+ok($hwdm2, "create hash2_with_data_migration element") ;
+eq_or_diff([$hwdm2->fetch_all_values], [ qw/baz0 foo bar/],"hash data after 2nd migration ") ;
+
+memory_cycle_ok($model,"test memory cycles");
View
3  config-model-core/t/model_tests.d/debian-dpkg-copyright-test-conf.pl
@@ -43,6 +43,9 @@
'Files:"*" License short_name' => "MPL-1.1",
'Files:"src/js/fdlibm/*" License short_name' => "MPL-1.1",
},
+ file_contents_like => {
+ 'debian/copyright' => qr/Format: http/ ,
+ }
},
# the empty license will default to 'other'
View
7 config-model-core/t/smooth_upgrade.t
@@ -132,6 +132,8 @@ is( $nfd->fetch, undef, "undef old and undef new");
# does not generate a warning
$dp -> store ('ini') ;
+$inst->initial_load_stop ;
+
is( $nfd->fetch, 'ini_file', "old is 'ini' and new is 'ini_file'");
is( $nfd->fetch_custom, 'ini_file', "likewise for custom_value");
@@ -181,10 +183,13 @@ warning_like {$dp = $uroot->fetch_element('old_url')->store($url) ;}
qr/Element 'old_url' of node 'UrlMigration' is deprecated/ ,
"check warning when fetching deprecated element" ;
+$uinst->initial_load_stop ;
+
my $h = $uroot->fetch_element('host');
is($h->fetch,$host,"check extracted host") ;
is($uroot->fetch_element('port')->fetch,$port,"check extracted port") ;
is($uroot->fetch_element('path')->fetch,$path,"check extracted path") ;
-memory_cycle_ok($model);
+
+memory_cycle_ok($model,"test memory cycles");
View
7 config-model-core/t/value.t
@@ -3,7 +3,7 @@
use warnings FATAL => qw(all);
use ExtUtils::testlib;
-use Test::More tests => 162;
+use Test::More tests => 163;
use Test::Exception;
use Test::Warn;
use Test::Memory::Cycle;
@@ -373,8 +373,13 @@ throws_ok { $mb->store('toto'); } 'Config::Model::Exception::User',
"enum: store 'toto' error";
print "normal error:\n", $@, "\n" if $trace;
+$inst->clear_changes ;
+
is( $de->fetch, 'A', "enum with default: read default value" );
+is($inst->needs_save,1,"check needs_save after reading a default value") ;
+$inst->clear_changes;
+
print "enum with default: read custom\n" if $trace;
is( $de->fetch_custom, undef, "enum with default: read custom value" );

No commit comments for this range

Something went wrong with that request. Please try again.