view release on metacpan or  search on metacpan

t/value.t  view on Meta::CPAN

    is( $win->has_fixes, 1, "test has_fixes" );
    $win->apply_fixes;
    is( $win->fetch, 'bar', "test if fixes were applied" );
};

subtest "integer_with_warn_if" => sub {
    my $iwwi = $root->fetch_element('integer_with_warn_if');
    {
        my $xp = Test::Log::Log4perl->expect(
            ignore_priority => 'info',
            ['User', warn => qr/should be greater than 9/]
        );
        $iwwi->store('5');
    }

    is( $iwwi->has_fixes, 1, "test has_fixes" );
    $iwwi->apply_fixes;
    is( $iwwi->fetch, 10, "test if fixes were applied" );
};

my $warn_unless_test = sub {
    my $wup = $root->fetch_element('warn_unless_match');
    my $v = shift;
    {
        my $xp = Test::Log::Log4perl->expect(
            ignore_priority => 'info',
            ['User', warn => qr/should match/]
        );
        $wup->store($v);
    }

    is( $wup->has_fixes, 1, "test has_fixes" );
    $wup->apply_fixes;
    is( $wup->fetch, "foo$v", "test if fixes were applied" );
};

subtest "warn_unless_match feature with unline value" => $warn_unless_test, "bar" ;
subtest "warn_unless_match feature with multiline value" => $warn_unless_test, "bar\nbaz\bazz\n";

subtest "unconditional feature" => sub {
    my $aw = $root->fetch_element('always_warn');
    my $xp = Test::Log::Log4perl->expect(
        ignore_priority => 'info',
        ['User', warn => qr/always/]
    );
    $aw->store('whatever');
};

subtest "warning and repeated storage in same element" => sub {
    my $aw = $root->fetch_element('always_warn');
    my $xp = Test::Log::Log4perl->expect(
        ignore_priority => 'info',
        [ 'User', ( warn => qr/always/ ) x 2 ]
    );
    $aw->store('what ?'); # warns
    $aw->store('what ?');  # does not warn
    $aw->store('what never'); # warns
};

subtest "unicode" => sub {
    my $wip = $root->fetch_element('warn_if_match');
    my $smiley = "\x{263A}";    # See programming perl chapter 15
    $wip->store(':-)');         # to test list_changes just below
    $wip->store($smiley);
    is( $wip->fetch, $smiley, "check utf-8 string" );
};

print join( "\n", $inst->list_changes("\n") ), "\n" if $trace;

subtest "replace_follow" => sub {
    my $wrf = $root->fetch_element('with_replace_follow');
    $inst->clear_changes;

    $wrf->store('foo');
    is( $inst->needs_save, 1, "check needs_save after store" );
    $inst->clear_changes;

    is( $wrf->fetch,       'foo', "check replacement_hash with foo (before replacement)" );
    is( $inst->needs_save, 0,     "check needs_save after simple fetch" );

    $root->load('replacement_hash:foo=repfoo replacement_hash:bar=repbar');
    is( $inst->needs_save, 2, "check needs_save after load" );
    $inst->clear_changes;

    is( $wrf->fetch,       'repfoo', "check replacement_hash with foo (after replacement)" );
    is( $inst->needs_save, 1,        "check needs_save after fetch with replacement" );

    $wrf->store('bar');
    is( $wrf->fetch, 'repbar', "check replacement_hash with bar" );

    $wrf->store('baz');
    is( $wrf->fetch, 'baz', "check replacement_hash with baz (no replacement)" );

    ok(
        !$root->fetch_element('replacement_hash')->exists('baz'),
        "check that replacement hash was not changed by missed substitution"
    );

    $inst->clear_changes;
};

subtest "Standards-Version" => sub {
    my $sv = $root->fetch_element('Standards-Version');
    {
        my $xp = Test::Log::Log4perl->expect(
            ignore_priority => 'info',
            ['User', warn => qr/Current/]
        );
        # store old standard version
        $sv->store('3.9.1');
    }
    is( $inst->needs_save, 1, "check needs_save after load" );
    $sv->apply_fixes;
    is( $inst->needs_save, 2, "check needs_save after load" );
    print join( "\n", $inst->list_changes("\n") ), "\n" if $trace;

    is( $sv->fetch, '3.9.2', "check fixed standard version" );

    is( $sv->fetch( mode => 'custom' ), undef, "check custom standard version" );
};