Suppress a few compilation warnings in pp_hot.c.
[p5sagit/p5-mst-13.2.git] / t / op / chop.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 plan tests => 51;
10
11 $_ = 'abc';
12 $c = do foo();
13 is ($c . $_, 'cab', 'optimized');
14
15 $_ = 'abc';
16 $c = chop($_);
17 is ($c . $_ , 'cab', 'unoptimized');
18
19 sub foo {
20     chop;
21 }
22
23 @foo = ("hi \n","there\n","!\n");
24 @bar = @foo;
25 chop(@bar);
26 is (join('',@bar), 'hi there!');
27
28 $foo = "\n";
29 chop($foo,@foo);
30 is (join('',$foo,@foo), 'hi there!');
31
32 $_ = "foo\n\n";
33 $got = chomp();
34 ok ($got == 1) or print "# got $got\n";
35 is ($_, "foo\n");
36
37 $_ = "foo\n";
38 $got = chomp();
39 ok ($got == 1) or print "# got $got\n";
40 is ($_, "foo");
41
42 $_ = "foo";
43 $got = chomp();
44 ok ($got == 0) or print "# got $got\n";
45 is ($_, "foo");
46
47 $_ = "foo";
48 $/ = "oo";
49 $got = chomp();
50 ok ($got == 2) or print "# got $got\n";
51 is ($_, "f");
52
53 $_ = "bar";
54 $/ = "oo";
55 $got = chomp();
56 ok ($got == 0) or print "# got $got\n";
57 is ($_, "bar");
58
59 $_ = "f\n\n\n\n\n";
60 $/ = "";
61 $got = chomp();
62 ok ($got == 5) or print "# got $got\n";
63 is ($_, "f");
64
65 $_ = "f\n\n";
66 $/ = "";
67 $got = chomp();
68 ok ($got == 2) or print "# got $got\n";
69 is ($_, "f");
70
71 $_ = "f\n";
72 $/ = "";
73 $got = chomp();
74 ok ($got == 1) or print "# got $got\n";
75 is ($_, "f");
76
77 $_ = "f";
78 $/ = "";
79 $got = chomp();
80 ok ($got == 0) or print "# got $got\n";
81 is ($_, "f");
82
83 $_ = "xx";
84 $/ = "xx";
85 $got = chomp();
86 ok ($got == 2) or print "# got $got\n";
87 is ($_, "");
88
89 $_ = "axx";
90 $/ = "xx";
91 $got = chomp();
92 ok ($got == 2) or print "# got $got\n";
93 is ($_, "a");
94
95 $_ = "axx";
96 $/ = "yy";
97 $got = chomp();
98 ok ($got == 0) or print "# got $got\n";
99 is ($_, "axx");
100
101 # This case once mistakenly behaved like paragraph mode.
102 $_ = "ab\n";
103 $/ = \3;
104 $got = chomp();
105 ok ($got == 0) or print "# got $got\n";
106 is ($_, "ab\n");
107
108 # Go Unicode.
109
110 $_ = "abc\x{1234}";
111 chop;
112 is ($_, "abc", "Go Unicode");
113
114 $_ = "abc\x{1234}d";
115 chop;
116 is ($_, "abc\x{1234}");
117
118 $_ = "\x{1234}\x{2345}";
119 chop;
120 is ($_, "\x{1234}");
121
122 my @stuff = qw(this that);
123 is (chop(@stuff[0,1]), 't');
124
125 # bug id 20010305.012
126 @stuff = qw(ab cd ef);
127 is (chop(@stuff = @stuff), 'f');
128
129 @stuff = qw(ab cd ef);
130 is (chop(@stuff[0, 2]), 'f');
131
132 my %stuff = (1..4);
133 is (chop(@stuff{1, 3}), '4');
134
135 # chomp should not stringify references unless it decides to modify them
136 $_ = [];
137 $/ = "\n";
138 $got = chomp();
139 ok ($got == 0) or print "# got $got\n";
140 is (ref($_), "ARRAY", "chomp ref (modify)");
141
142 $/ = ")";  # the last char of something like "ARRAY(0x80ff6e4)"
143 $got = chomp();
144 ok ($got == 1) or print "# got $got\n";
145 ok (!ref($_), "chomp ref (no modify)");
146
147 $/ = "\n";
148
149 %chomp = ("One" => "One", "Two\n" => "Two", "" => "");
150 %chop = ("One" => "On", "Two\n" => "Two", "" => "");
151
152 foreach (keys %chomp) {
153   my $key = $_;
154   eval {chomp $_};
155   if ($@) {
156     my $err = $@;
157     $err =~ s/\n$//s;
158     fail ("\$\@ = \"$err\"");
159   } else {
160     is ($_, $chomp{$key}, "chomp hash key");
161   }
162 }
163
164 foreach (keys %chop) {
165   my $key = $_;
166   eval {chop $_};
167   if ($@) {
168     my $err = $@;
169     $err =~ s/\n$//s;
170     fail ("\$\@ = \"$err\"");
171   } else {
172     is ($_, $chop{$key}, "chop hash key");
173   }
174 }
175
176 # chop and chomp can't be lvalues
177 eval 'chop($x) = 1;';
178 ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
179 eval 'chomp($x) = 1;';
180 ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
181 eval 'chop($x, $y) = (1, 2);';
182 ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
183 eval 'chomp($x, $y) = (1, 2);';
184 ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
185