File: Hash-StoredIterator.t

package info (click to toggle)
libhash-storediterator-perl 0.008-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 304 kB
  • sloc: perl: 143; makefile: 3
file content (216 lines) | stat: -r--r--r-- 4,807 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
use Test2::Bundle::Extended -target => 'Hash::StoredIterator';
use Test2::Tools::Spec;

use Hash::StoredIterator ':all';

my %hash = ( a => 1, b => 2, c => 3 );

my @want_outer = (
    [a => 1],
    [b => 2],
    [c => 3],
);

my @want_inner = (
    [a => 1],
    [a => 1],
    [a => 1],
    [b => 2],
    [b => 2],
    [b => 2],
    [c => 3],
    [c => 3],
    [c => 3],
);

describe eaches => sub {
    my $interference;

    case no_interference => sub {
        $interference = sub { 1 };
    };

    # In the interference case, this sub which uses keys, values, and each on
    # our hash is called nested inside our custom calls, they should not
    # interfere as they would with builtins.
    case interference => sub {
        $interference = sub {
            my @garbage = keys(%hash), values(%hash);
            while ( my ( $k, $v ) = each(%hash) ) {
                # Effectively do nothing
                my $foo = $k . $v;
            }
        };
    };

    tests nested_eich => sub {
        my @inner;
        my @outer;

        warnings {
            my $o_it;
            while ( my ( $k, $v ) = eich( %hash, $o_it ) ) {
                push @outer => [$k, $v];
                $interference->();

                my $i_it;
                while ( my ( $k, $v ) = eich( %hash, $i_it ) ) {
                    push @inner => [$k, $v];

                    $interference->();
                }
            }
        };

        is(
            [sort { $a->[0] cmp $b->[0] } @outer],
            \@want_outer,
            "Out loop got all keys"
        );

        is(
            [sort { $a->[0] cmp $b->[0] } @inner],
            \@want_inner,
            "Inner loop got all keys multiple times"
        );
    };

    tests nested_hmap => sub {
        my @inner;
        my @outer;

        #<<< no-tidy  Perltidy hates this...
        hmap {
            my ( $k, $v ) = @_;
            ok( $k, "Got key" );
            ok( $v, "Got val" );
            is( $k, $_, '$_ is set to key' );
            is( $k, $a, '$a is set to key' );
            is( $v, $b, '$b is set to val' );

            push @outer => [$k, $v];
            $interference->();

            hmap {
                my ( $k2, $v2 ) = @_;

                is( $k2, $_, '$_ is set to key' );
                is( $k2, $a, '$a is set to key' );
                is( $v2, $b, '$b is set to val' );

                push @inner => [$k, $v];

                $interference->();
            } %hash;

            is( $k, $_, '$_ is not squashed by inner loop' );
            is( $k, $a, '$a is not squashed by inner loop' );
            is( $v, $b, '$a is not squashed by inner loop' );
        } %hash;
        #>>>

        is(
            [sort { $a->[0] cmp $b->[0] } @outer],
            \@want_outer,
            "Outer loop got all keys"
        );

        is(
            [sort { $a->[0] cmp $b->[0] } @inner],
            \@want_inner,
            "Inner loop got all keys multiple times"
        );
    };
};

tests get_from_eich => sub {
    my $i;
    my $h = {%hash};

    warnings {
        my ( $k, $v ) = eich( %$h, $i );
        ok( $k, "Got a key" );
        ok( $v, "got a value" );
    };
};

tests keys_and_vals => sub {
    is(
        [sort( hkeys(%hash) )],
        [sort keys %hash],
        "Same list from both keys and hkeys"
    );

    is(
        [sort( hvalues(%hash) )],
        [sort values %hash],
        "Same list from both values and hvalues"
    );
};

tests death => sub {
    my $counter = 0;

    my %hash = map { $_ => $_ } 'a' .. 'z';

    # Set an initial iterator
    my ($garbage) = each(%hash);

    #<<< no-tidy  Perltidy hates this...
    eval {
        hmap {
            my ( $k, $v ) = @_;
            die "foo" if $counter++ > 3;
        } %hash;
    };
    #>>>

    like( $@, qr/foo/, "Got error" );

    # Get key at current iteration, it should match the second key
    my ($key) = each(%hash);
    my ( $fkey, $skey ) = keys(%hash);
    is( $garbage, $fkey, "First key matches initial garbage key" );
    is( $key,     $skey, "Iterator was restored" );
};

tests strange_edge_case => { todo => "Not sure what the problem is here..." } => sub {
    is(
        [sort hkeys %hash],
        [sort keys %hash],
        "Same list from both keys and hkeys"
    );

    is(
        [sort hkeys(%hash)],
        [sort keys %hash],
        "Same list from both keys and hkeys"
    );
};

tests iterator => sub {
    my $i = iterator %hash;

    my $nh = {
        $i->(),
        $i->(),
        $i->(),
    };

    is(
        $nh,
        \%hash,
        "Copied hash via iterator"
    );

    is(
        [$i->()],
        [],
        "End, no more"
    );

    my ($k, $v) = $i->();
    ok( $k && $v, "Got a key and value, iterator was reset" );
};

done_testing;