view release on metacpan or  search on metacpan

t/value.t  view on Meta::CPAN

            }
        },
    ],
);

$model->create_config_class(
    name    => "TomlLoad",
    element => [
        data_from_toml_file => {
            type => 'leaf',
            value_type => 'uniline',
            update => {
                when_missing => 'warn',
                files => [
                    { type => 'toml', file => $toml_file->stringify, subpath => "foo.bar"}
            ]}
        },
    ],
);

my $bad_inst = $model->instance(
    root_class_name => 'BadClass',
    instance_name   => 'test_bad_class'
);
ok( $bad_inst, "created bad_class instance" );
$bad_inst->initial_load_stop;

my $bad_root = $bad_inst->config_root;

throws_ok { $bad_root->fetch_element('crooked'); }
    'Config::Model::Exception::Model',
    "test create expected failure";
print "normal error:\n", $@, "\n" if $trace;

my $inst = $model->instance(
    root_class_name => 'Master',
    # root_dir is used to test warn_unless_file
    root_dir => 't',
    instance_name   => 'test1'
);
ok( $inst, "created dummy instance" );
$inst->initial_load_stop;

sub check_store_error {
    my ( $obj, $v, $qr ) = @_;
    my $path = $obj->location;
    $obj->store( value => $v, silent => 1, check => 'skip' );
    is( $inst->errors->{$path}, '', "store error in $path is tracked" );
    like( scalar $inst->error_messages, $qr, "check $path error message" );
}

sub check_error {
    my ( $obj, $v, $qr ) = @_;
    my $old_v = $obj->fetch;
    check_store_error(@_);
    is( $obj->fetch, $old_v, "check that wrong value $v was not stored" );
}

my $root = $inst->config_root;

subtest "check backup immutability" => sub {
    my $i = $root->fetch_element('scalar');
    my $backup = $i->backup();
    is($backup->{min},1, "check backedup value");
    $backup->{min} = 0;
    is($i->backup()->{min},1, "check stored backedup value");
};

subtest "simple scalar" => sub {
    my $i = $root->fetch_element('scalar');
    ok( $i, "test create bounded integer" );

    is( $inst->needs_save, 0, "verify instance needs_save status after creation" );

    is( $i->needs_check, 1, "verify check status after creation" );

    is( $i->has_data, 0, "check has_data on empty scalar" );

    $i->store(1);
    ok( 1, "store test done" );
    is( $i->needs_check,   0, "store does not trigger a check (check done during store)" );
    is( $inst->needs_save, 1, "verify instance needs_save status after store" );
    is( $i->has_data, 1, "check has_data after store" );

    is( $i->fetch,         1, "fetch test" );
    is( $i->needs_check,   0, "check was done during fetch" );
    is( $inst->needs_save, 1, "verify instance needs_save status after fetch" );

    ok($i->check_value(), "call check_value without argument");
};

subtest "error handling on simple scalar" => sub {
    my $i = $root->fetch_element('scalar');
    check_error( $i, 5, qr/max limit/ );

    check_error( $i, 'toto', qr/not of type/ );

    check_error( $i, 1.5, qr/number but not an integer/ );

    # test that bad storage triggers an error
    throws_ok { $i->store(5); } 'Config::Model::Exception::WrongValue', "test max nb expected failure";
    print "normal error:\n", $@, "\n" if $trace;

    ok( ! $i->store(value => 5, check => 'skip'), "bad value was skipped");
    is($i->fetch,1,"check original value");

    is($i->store(value => 5, check => 'no'),1 ,"bad value was force fed");
    is($i->fetch(check => 'no'),5,"check stored bad value");

    throws_ok { $i->fetch() } 'Config::Model::Exception::WrongValue', "check that reading a bad value trigges an error";
    is($i->fetch(check => 'skip'),undef,"check bad read value can be skipped");
    is($i->fetch(check => 'no'),5,"check stored bad value has not changed");

    $i->store(1); # fix the error condition
};

subtest "summary method" => sub {
    my $i = $root->fetch_element('scalar');
    $i->store(4);
    is($i->fetch_summary, 4, "test summary on integer");

    my $s = $root->fetch_element('string');
    $s->store("Lorem ipsum dolor sit amet, consectetur adipiscing elit,");
    is($s->fetch_summary, "Lorem ipsum dol...", "test summary on string");

    $s->store("Lorem ipsum\ndolor sit amet, consectetur adipiscing elit,");