xref: /openbsd/gnu/usr.bin/perl/t/op/reverse.t (revision cecf84d4) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6    require './test.pl';
7}
8
9plan tests => 26;
10
11is(reverse("abc"), "cba", 'simple reverse');
12
13$_ = "foobar";
14is(reverse(), "raboof", 'reverse of the default variable');
15
16{
17    my @a = ("foo", "bar");
18    my @b = reverse @a;
19
20    is($b[0], $a[1], 'array reversal moved second element to first');
21    is($b[1], $a[0], 'array reversal moved first element to second');
22}
23
24{
25    my @a = (1, 2, 3, 4);
26    @a = reverse @a;
27    is("@a", "4 3 2 1", 'four element array reversed');
28
29    delete $a[1];
30    @a = reverse @a;
31    ok(!exists $a[2], 'array reversed with deleted second element');
32    is($a[0] . $a[1] . $a[3], '124', 'remaining elements ok after delete and reverse');
33
34    @a = (5, 6, 7, 8, 9);
35    @a = reverse @a;
36    is("@a", "9 8 7 6 5", 'five element array reversed');
37
38    delete $a[3];
39    @a = reverse @a;
40    ok(!exists $a[1], 'five element array reversed with deleted fourth element');
41    is($a[0] . $a[2] . $a[3] . $a[4], '5789', 'remaining elements ok after delete and reverse');
42
43    delete $a[2];
44    @a = reverse @a;
45    ok(!exists $a[2] && !exists $a[3], 'test position of two deleted elements after reversal');
46    is($a[0] . $a[1] . $a[4], '985', 'check value of remaining elements');
47
48    my @empty;
49    @empty = reverse @empty;
50    is("@empty", "", 'reversed empty array is still empty');
51}
52
53use Tie::Array;
54
55{
56    tie my @a, 'Tie::StdArray';
57
58    @a = (1, 2, 3, 4);
59    @a = reverse @a;
60    is("@a", "4 3 2 1", 'tie array reversal');
61
62    delete $a[1];
63    @a = reverse @a;
64    ok(!exists $a[2], 'deleted element position ok after reversal of tie array');
65    is($a[0] . $a[1] . $a[3], '124', 'remaining elements ok after delete and reversal for tie array');
66
67    @a = (5, 6, 7, 8, 9);
68    @a = reverse @a;
69    is("@a", "9 8 7 6 5", 'five element tie array reversal');
70
71    delete $a[3];
72    @a = reverse @a;
73    ok(!exists $a[1], 'deleted element position ok after tie array reversal');
74    is($a[0] . $a[2] . $a[3] . $a[4], '5789', 'remaining elements ok after tie array delete and reversal');
75
76    delete $a[2];
77    @a = reverse @a;
78    ok(!exists $a[2] && !exists $a[3], 'two deleted element positions ok after tie array reversal');
79    is($a[0] . $a[1] . $a[4], '985', 'remaining elements ok after two deletes and reversals');
80
81    tie my @empty, "Tie::StdArray";
82    @empty = reverse @empty;
83    is(scalar(@empty), 0, 'reversed tie array still empty after reversal');
84}
85
86{
87    # Unicode.
88
89    my $a = "\x{263A}\x{263A}x\x{263A}y\x{263A}";
90    my $b = scalar reverse($a);
91    my $c = scalar reverse($b);
92    is($a, $c, 'Unicode string double reversal matches original');
93}
94
95{
96    # Lexical $_.
97    no warnings 'experimental::lexical_topic';
98    sub blurp { my $_ = shift; reverse }
99
100    is(blurp("foo"), "oof", 'reversal of default variable in function');
101    is(sub { my $_ = shift; reverse }->("bar"), "rab", 'reversal of default variable in anonymous function');
102    {
103        local $_ = "XXX";
104        is(blurp("paz"), "zap", 'reversal of default variable with local value set' );
105    }
106}
107