view release on metacpan or  search on metacpan

t/89_mm_table.t  view on Meta::CPAN

    ok( $t, 'make() returns object even with nelts 0' );
    isa_ok( $t, 'MM::Table' );

    $t->set( Foo => 'one' );
    $t->add( Foo => 'two' );

    my $copy = $t->copy( undef );
    ok( $copy, 'copy() returns object' );
    isa_ok( $copy, 'MM::Table' );

    is( $copy->get( 'foo' ), 'one', 'copy keeps data (scalar get oldest)' );
    my @vals = $copy->get( 'foo' );
    is_deeply( \@vals, [ 'one', 'two' ], 'copy keeps data (list get all)' );

    $t->clear();
    is( $t->get( 'foo' ), undef, 'clear removes everything' );
    my @none = $t->get( 'foo' );
    is_deeply( \@none, [], 'clear: list context empty' );
};

# NOTE: set/add/unset/get ordering + case-insensitive keys
subtest 'set/add/unset/get ordering + case-insensitive keys' => sub
{
    my $t = MM::Table->make( undef, 10 );

    $t->set( Foo => 'one' );
    $t->add( foo => 'two' );
    $t->add( FOO => 'three' );

    is( $t->get( 'fOo' ), 'one', 'scalar get returns oldest value' );

    my @vals = $t->get( 'foo' );
    is_deeply( \@vals, [ 'one', 'two', 'three' ], 'list get returns all in insertion order' );

    $t->unset( 'FOO' );
    is( $t->get( 'foo' ), undef, 'unset removes all values for key (case-insensitive)' );
};

# NOTE: merge semantics (first value only) + missing key
subtest 'merge semantics (first value only) + missing key' => sub
{
    my $t = MM::Table->make( undef, 10 );

    $t->set( merge => '1' );
    $t->merge( merge => 'a' );
    is( $t->get( 'merge' ), '1, a', 'merge appends to first value using ", "' );

    $t->clear();
    $t->set( merge => '1' );
    $t->add( merge => '2' );
    $t->merge( merge => 'a' );

    my @vals = $t->get( 'merge' );
    is_deeply( \@vals, [ '1, a', '2' ], 'merge affects only first (oldest) value of multivalued key' );

    $t->clear();
    $t->merge( miss => 'a' );
    is( $t->get( 'miss' ), 'a', 'merge on missing key behaves like add()' );
};

# NOTE: overlay semantics (new table = overlay first, then base)
subtest 'overlay semantics (new table = overlay first, then base)' => sub
{
    my $base = MM::Table->make( undef, 10 );
    my $add  = MM::Table->make( undef, 10 );

    $base->set( bar => 'beer' );
    $base->set( foo => 'one' );
    $base->add( foo => 'two' );

    $add->set( foo => 'three' );

    my $ov = $base->overlay( $add, undef );

    _pairs_eq(
        _dump_table_pairs( $ov ),
        [
            [ 'foo', 'three' ],
            [ 'bar', 'beer' ],
            [ 'foo', 'one' ],
            [ 'foo', 'two'  ],
        ],
        'overlay pair order'
    );

    # Verify originals unmodified
    _pairs_eq(
        _dump_table_pairs( $base ),
        [
            [ 'bar', 'beer' ],
            [ 'foo', 'one'  ],
            [ 'foo', 'two'  ],
        ],
        'base unmodified after overlay'
    );

    _pairs_eq(
        _dump_table_pairs( $add ),
        [
            [ 'foo', 'three' ],
        ],
        'add unmodified after overlay'
    );
};

# NOTE: compress SET (keep last) and MERGE (comma list) with stable order by first occurrence
subtest 'compress SET (keep last) and MERGE (comma list) with stable order by first occurrence' => sub
{
    my $t = MM::Table->make( undef, 10 );

    $t->set( bar => 'beer' );
    $t->set( foo => 'one' );
    $t->add( foo => 'two' );
    $t->add( foo => 'three' );

    my $t_set = $t->copy( undef );
    $t_set->compress( OVERLAP_TABLES_SET );

    _pairs_eq(
        _dump_table_pairs( $t_set ),
        [
            [ 'bar', 'beer'  ],
            [ 'foo', 'three' ],
        ],
        'compress SET result'
    );

    my $t_merge = $t->copy( undef );
    $t_merge->compress( OVERLAP_TABLES_MERGE );

    _pairs_eq(
        _dump_table_pairs( $t_merge ),
        [
            [ 'bar', 'beer'             ],
            [ 'foo', 'one, two, three'  ],
        ],
        'compress MERGE result'
    );
};

# NOTE: overlap SET overwrites key entirely; overlap MERGE merges into first value
subtest 'overlap SET overwrites key entirely; overlap MERGE merges into first value' => sub
{
    my $base = MM::Table->make( undef, 10 );
    my $add  = MM::Table->make( undef, 10 );

    $base->set( bar => 'beer' );
    $base->set( foo => 'one' );
    $base->add( foo => 'two' );
    $add->set( foo => 'three' );

    my $set = $base->copy( undef );
    $set->overlap( $add, OVERLAP_TABLES_SET );

    _pairs_eq(
        _dump_table_pairs( $set ),
        [
            [ 'bar', 'beer'  ],
            [ 'foo', 'three' ],
        ],
        'overlap SET'
    );