[MERGE] fix PERL_GLOBAL_STRUCT builds
[perl.git] / t / op / reverse.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 plan tests => 24;
10
11 is(reverse("abc"), "cba", 'simple reverse');
12
13 $_ = "foobar";
14 is(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
53 use 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 # [perl #132544] stack pointer used to go wild when nullary reverse
96 # required extending the stack
97 for(0..1000){()=(0..$_,scalar reverse )}
98 pass "extending the stack without crashing";