Move the require './test.pl' to the end of t/comp/hints.t
[p5sagit/p5-mst-13.2.git] / t / base / lex.t
CommitLineData
8d063cd8 1#!./perl
2
df3467db 3print "1..57\n";
8d063cd8 4
79072805 5$x = 'x';
8d063cd8 6
79072805 7print "#1 :$x: eq :x:\n";
8if ($x eq 'x') {print "ok 1\n";} else {print "not ok 1\n";}
8d063cd8 9
1a9b3510 10$x = $#[0];
8d063cd8 11
12if ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";}
13
14$x = $#x;
15
16if ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";}
17
18$x = '\\'; # ';
19
20if (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";}
a559c259 21
22eval 'while (0) {
23 print "foo\n";
24}
25/^/ && (print "ok 5\n");
26';
27
28eval '$foo{1} / 1;';
79072805 29if (!$@) {print "ok 6\n";} else {print "not ok 6 $@\n";}
378cc40b 30
31eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;';
32
33$foo = int($foo * 100 + .5);
87250799 34if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 :$foo:\n";}
a687059c 35
36print <<'EOF';
37ok 8
38EOF
39
40$foo = 'ok 9';
41print <<EOF;
42$foo
43EOF
44
45eval <<\EOE, print $@;
46print <<'EOF';
47ok 10
48EOF
49
50$foo = 'ok 11';
51print <<EOF;
52$foo
53EOF
54EOE
55
972e7321 56print <<'EOS' . <<\EOF;
57ok 12 - make sure single quotes are honored \nnot ok
a687059c 58EOS
59ok 13
60EOF
61
62print qq/ok 14\n/;
63print qq(ok 15\n);
64
65print qq
a0d0e21e 66[ok 16\n]
a687059c 67;
68
69print q<ok 17
70>;
71
72print <<; # Yow!
73ok 18
74
75# previous line intentionally left blank.
79072805 76
2ba53c57 77print <<E1 eq "foo\n\n" ? "ok 19\n" : "not ok 19\n";
78@{[ <<E2 ]}
79foo
80E2
81E1
82
83print <<E1 eq "foo\n\n" ? "ok 20\n" : "not ok 20\n";
84@{[
85 <<E2
86foo
87E2
88]}
89E1
90
79072805 91$foo = FOO;
92$bar = BAR;
93$foo{$bar} = BAZ;
94$ary[0] = ABC;
95
2ba53c57 96print "$foo{$bar}" eq "BAZ" ? "ok 21\n" : "not ok 21\n";
79072805 97
2ba53c57 98print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 22\n" : "not ok 22\n";
99print "${foo{$bar}}" eq "BAZ" ? "ok 23\n" : "not ok 23\n";
79072805 100
2ba53c57 101print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n";
102print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n";
103print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n";
1bcde0ca 104
f27ffc4a 105# MJD 19980425
106($X, @X) = qw(a b c d);
107print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n";
108print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n";
a2c06652 109
f27ffc4a 110print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
111
112
113$foo = "not ok 30\n";
a2c06652 114$foo =~ s/^not /substr(<<EOF, 0, 0)/e;
115 Ignored
116EOF
117print $foo;
2b92dfce 118
119# Tests for new extended control-character variables
120# MJD 19990227
121
122{ my $CX = "\cX";
123 my $CXY ="\cXY";
124 $ {$CX} = 17;
125 $ {$CXY} = 23;
126 if ($ {^XY} != 23) { print "not " }
127 print "ok 31\n";
128
129# Does the syntax where we use the literal control character still work?
765cb2dc 130 if (eval "\$ {\cX}" != 17 or $@) { print "not " }
2b92dfce 131 print "ok 32\n";
132
766c8ce8 133 eval "\$\cQ = 24"; # Literal control character
134 if ($@ or ${"\cQ"} != 24) { print "not " }
2b92dfce 135 print "ok 33\n";
766c8ce8 136 if ($^Q != 24) { print "not " } # Control character escape sequence
2b92dfce 137 print "ok 34\n";
138
139# Does the old UNBRACED syntax still do what it used to?
140 if ("$^XY" ne "17Y") { print "not " }
141 print "ok 35\n";
142
143 sub XX () { 6 }
766c8ce8 144 $ {"\cQ\cXX"} = 119;
145 $^Q = 5; # This should be an unused ^Var.
2b92dfce 146 $N = 5;
147 # The second caret here should be interpreted as an xor
766c8ce8 148 if (($^Q^XX) != 3) { print "not " }
2b92dfce 149 print "ok 36\n";
150# if (($N ^ XX()) != 3) { print "not " }
151# print "ok 32\n";
152
153 # These next two tests are trying to make sure that
154 # $^FOO is always global; it doesn't make sense to `my' it.
155 #
0244c3a4 156
2b92dfce 157 eval 'my $^X;';
158 print "not " unless index ($@, 'Can\'t use global $^X in "my"') > -1;
159 print "ok 37\n";
160# print "($@)\n" if $@;
161
162 eval 'my $ {^XYZ};';
163 print "not " unless index ($@, 'Can\'t use global $^XYZ in "my"') > -1;
164 print "ok 38\n";
165# print "($@)\n" if $@;
166
167# Now let's make sure that caret variables are all forced into the main package.
168 package Someother;
766c8ce8 169 $^Q = 'Someother';
170 $ {^Quixote} = 'Someother 2';
2b92dfce 171 $ {^M} = 'Someother 3';
172 package main;
766c8ce8 173 print "not " unless $^Q eq 'Someother';
2b92dfce 174 print "ok 39\n";
766c8ce8 175 print "not " unless $ {^Quixote} eq 'Someother 2';
2b92dfce 176 print "ok 40\n";
177 print "not " unless $ {^M} eq 'Someother 3';
178 print "ok 41\n";
179
180
181}
182
0244c3a4 183# see if eval '', s///e, and heredocs mix
2b92dfce 184
0244c3a4 185sub T {
186 my ($where, $num) = @_;
187 my ($p,$f,$l) = caller;
188 print "# $p:$f:$l vs /$where/\nnot " unless "$p:$f:$l" =~ /$where/;
189 print "ok $num\n";
190}
191
192my $test = 42;
193
194{
195# line 42 "plink"
196 local $_ = "not ok ";
197 eval q{
198 s/^not /<<EOT/e and T '^main:\(eval \d+\):2$', $test++;
199# fuggedaboudit
200EOT
201 print $_, $test++, "\n";
202 T('^main:\(eval \d+\):6$', $test++);
203# line 1 "plunk"
204 T('^main:plunk:1$', $test++);
205 };
206 print "# $@\nnot ok $test\n" if $@;
207 T '^main:plink:53$', $test++;
208}
8593bda5 209
210# tests 47--51 start here
211# tests for new array interpolation semantics:
212# arrays now *always* interpolate into "..." strings.
213# 20000522 MJD (mjd@plover.com)
214{
215 my $test = 47;
216 eval(q(">@nosuch<" eq "><")) || print "# $@", "not ";
217 print "ok $test\n";
218 ++$test;
219
220 # Look at this! This is going to be a common error in the future:
221 eval(q("fred@example.com" eq "fred.com")) || print "# $@", "not ";
222 print "ok $test\n";
223 ++$test;
224
225 # Let's make sure that normal array interpolation still works right
226 # For some reason, this appears not to be tested anywhere else.
227 my @a = (1,2,3);
228 print +((">@a<" eq ">1 2 3<") ? '' : 'not '), "ok $test\n";
229 ++$test;
230
231 # Ditto.
232 eval(q{@nosuch = ('a', 'b', 'c'); ">@nosuch<" eq ">a b c<"})
233 || print "# $@", "not ";
234 print "ok $test\n";
235 ++$test;
236
237 # This isn't actually a lex test, but it's testing the same feature
238 sub makearray {
239 my @array = ('fish', 'dog', 'carrot');
240 *R::crackers = \@array;
241 }
242
243 eval(q{makearray(); ">@R::crackers<" eq ">fish dog carrot<"})
244 || print "# $@", "not ";
245 print "ok $test\n";
246 ++$test;
247}
ce29ac45 248
249# Tests 52-54
250# => should only quote foo::bar if it isn't a real sub. AMS, 20010621
251
252sub xyz::foo { "bar" }
253my %str = (
254 foo => 1,
255 xyz::foo => 1,
256 xyz::bar => 1,
257);
258
259my $test = 52;
260print ((exists $str{foo} ? "" : "not ")."ok $test\n"); ++$test;
261print ((exists $str{bar} ? "" : "not ")."ok $test\n"); ++$test;
262print ((exists $str{xyz::bar} ? "" : "not ")."ok $test\n"); ++$test;
62444305 263
264sub foo::::::bar { print "ok $test\n"; $test++ }
265foo::::::bar;
356c7adf 266
267eval "\$x =\xE2foo";
b1fc3636 268if ($@ =~ /Unrecognized character \\xE2; marked by <-- HERE after \$x =<-- HERE near column 5/) { print "ok $test\n"; } else { print "not ok $test\n"; }
356c7adf 269$test++;
df3467db 270
271# Is "[~" scanned correctly?
f50fa36f 272@a = (1,2,3);
273print "not " unless($a[~~2] == 3);
df3467db 274print "ok 57\n";