spell "SSize_t" correctly
[perl.git] / t / base / lex.t
1 #!./perl
2
3 print "1..91\n";
4
5 $x = 'x';
6
7 print "#1       :$x: eq :x:\n";
8 if ($x eq 'x') {print "ok 1\n";} else {print "not ok 1\n";}
9
10 $x = $#[0];
11
12 if ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";}
13
14 $x = $#x;
15
16 if ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";}
17
18 $x = '\\'; # ';
19
20 if (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";}
21
22 eval 'while (0) {
23     print "foo\n";
24 }
25 /^/ && (print "ok 5\n");
26 ';
27
28 eval '$foo{1} / 1;';
29 if (!$@) {print "ok 6\n";} else {print "not ok 6 $@\n";}
30
31 eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;';
32
33 $foo = int($foo * 100 + .5);
34 if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 :$foo:\n";}
35
36 print <<'EOF';
37 ok 8
38 EOF
39
40 $foo = 'ok 9';
41 print <<EOF;
42 $foo
43 EOF
44
45 eval <<\EOE, print $@;
46 print <<'EOF';
47 ok 10
48 EOF
49
50 $foo = 'ok 11';
51 print <<EOF;
52 $foo
53 EOF
54 EOE
55
56 print <<'EOS' . <<\EOF;
57 ok 12 - make sure single quotes are honored \nnot ok
58 EOS
59 ok 13
60 EOF
61
62 print qq/ok 14\n/;
63 print qq(ok 15\n);
64
65 print qq
66 [ok 16\n]
67 ;
68
69 print q<ok 17
70 >;
71
72 print "ok 18 - was the test for the deprecated use of bare << to mean <<\"\"\n";
73 #print <<;   # Yow!
74 #ok 18
75 #
76 ## previous line intentionally left blank.
77
78 print <<E1 eq "foo\n\n" ? "ok 19\n" : "not ok 19\n";
79 @{[ <<E2 ]}
80 foo
81 E2
82 E1
83
84 print <<E1 eq "foo\n\n" ? "ok 20\n" : "not ok 20\n";
85 @{[
86   <<E2
87 foo
88 E2
89 ]}
90 E1
91
92 $foo = FOO;
93 $bar = BAR;
94 $foo{$bar} = BAZ;
95 $ary[0] = ABC;
96
97 print "$foo{$bar}" eq "BAZ" ? "ok 21\n" : "not ok 21\n";
98
99 print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 22\n" : "not ok 22\n";
100 print "${foo{$bar}}" eq "BAZ" ? "ok 23\n" : "not ok 23\n";
101
102 print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n";
103 print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n";
104 print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n";
105
106 # MJD 19980425
107 ($X, @X) = qw(a b c d); 
108 print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n";
109 print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n";
110
111 print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
112
113
114 $foo = "not ok 30\n";
115 $foo =~ s/^not /substr(<<EOF, 0, 0)/e;
116   Ignored
117 EOF
118 print $foo;
119
120 # Tests for new extended control-character variables
121 # MJD 19990227
122
123 my $test = 31;
124
125 { my $CX = "\cX";
126   my $CXY  ="\cXY";
127   $ {$CX} = 17;
128   $ {$CXY} = 23;
129   if ($ {^XY} != 23) { print "not "  }
130   print "ok $test\n"; $test++;
131  
132 # Does the old UNBRACED syntax still do what it used to?
133   if ("$^XY" ne "17Y") { print "not " }
134   print "ok $test\n"; $test++;
135
136   sub XX () { 6 }
137   $ {"\cQ\cXX"} = 119; 
138   $^Q = 5; #  This should be an unused ^Var.
139   $N = 5;
140   # The second caret here should be interpreted as an xor
141   if (($^Q^XX) != 3) { print "not " } 
142   print "ok $test\n"; $test++;
143 #  if (($N  ^  XX()) != 3) { print "not " } 
144 #  print "ok $test\n"; $test++;
145
146   # These next two tests are trying to make sure that
147   # $^FOO is always global; it doesn't make sense to 'my' it.
148   # 
149
150   eval 'my $^X;';
151   print "not " unless index ($@, 'Can\'t use global $^X in "my"') > -1;
152   print "ok $test\n"; $test++;
153 #  print "($@)\n" if $@;
154
155   eval 'my $ {^XYZ};';
156   print "not " unless index ($@, 'Can\'t use global $^XYZ in "my"') > -1;
157   print "ok $test\n"; $test++;
158 #  print "($@)\n" if $@;
159
160 # Now let's make sure that caret variables are all forced into the main package.
161   package Someother;
162   $^Q = 'Someother';
163   $ {^Quixote} = 'Someother 2';
164   $ {^M} = 'Someother 3';
165   package main;
166   print "not " unless $^Q eq 'Someother';
167   print "ok $test\n"; $test++;
168   print "not " unless $ {^Quixote} eq 'Someother 2';
169   print "ok $test\n"; $test++;
170   print "not " unless $ {^M} eq 'Someother 3';
171   print "ok $test\n"; $test++;
172
173   
174 }
175
176 # see if eval '', s///e, and heredocs mix
177
178 sub T {
179     my ($where, $num) = @_;
180     my ($p,$f,$l) = caller;
181     print "# $p:$f:$l vs /$where/\nnot " unless "$p:$f:$l" =~ /$where/;
182     print "ok $num\n";
183 }
184
185 {
186 # line 42 "plink"
187     local $_ = "not ok ";
188     eval q{
189         s/^not /<<EOT/e and T '^main:\(eval \d+\):2$', $test++;
190 # uggedaboudit
191 EOT
192         print $_, $test++, "\n";
193         T('^main:\(eval \d+\):6$', $test++);
194 # line 1 "plunk"
195         T('^main:plunk:1$', $test++);
196     };
197     print "# $@\nnot ok $test\n" if $@;
198     T '^main:plink:53$', $test++;
199 }
200
201 # tests 47--51 start here
202 # tests for new array interpolation semantics:
203 # arrays now *always* interpolate into "..." strings.
204 # 20000522 MJD (mjd@plover.com)
205 {
206   eval(q(">@nosuch<" eq "><")) || print "# $@", "not ";
207   print "ok $test\n";
208   ++$test;
209
210   # Look at this!  This is going to be a common error in the future:
211   eval(q("fred@example.com" eq "fred.com")) || print "# $@", "not ";
212   print "ok $test\n";
213   ++$test;
214
215   # Let's make sure that normal array interpolation still works right
216   # For some reason, this appears not to be tested anywhere else.
217   my @a = (1,2,3);
218   print +((">@a<" eq ">1 2 3<") ? '' : 'not '), "ok $test\n";
219   ++$test;
220
221   # Ditto.
222   eval(q{@nosuch = ('a', 'b', 'c'); ">@nosuch<" eq ">a b c<"}) 
223       || print "# $@", "not ";
224   print "ok $test\n";
225   ++$test;
226
227   # This isn't actually a lex test, but it's testing the same feature
228   sub makearray {
229     my @array = ('fish', 'dog', 'carrot');
230     *R::crackers = \@array;
231   }
232
233   eval(q{makearray(); ">@R::crackers<" eq ">fish dog carrot<"})
234     || print "# $@", "not ";
235   print "ok $test\n";
236   ++$test;
237 }
238
239 # Tests 52-54
240 # => should only quote foo::bar if it isn't a real sub. AMS, 20010621
241
242 sub xyz::foo { "bar" }
243 my %str = (
244     foo      => 1,
245     xyz::foo => 1,
246     xyz::bar => 1,
247 );
248
249 print ((exists $str{foo}      ? "" : "not ")."ok $test\n"); ++$test;
250 print ((exists $str{bar}      ? "" : "not ")."ok $test\n"); ++$test;
251 print ((exists $str{xyz::bar} ? "" : "not ")."ok $test\n"); ++$test;
252
253 sub foo::::::bar { print "ok $test\n"; $test++ }
254 foo::::::bar;
255
256 eval "\$x =\xE2foo";
257 if ($@ =~ /Unrecognized character \\xE2; marked by <-- HERE after \$x =<-- HERE near column 5/) { print "ok $test\n"; } else { print "not ok $test\n"; }
258 $test++;
259
260 # Is "[~" scanned correctly?
261 @a = (1,2,3);
262 print "not " unless($a[~~2] == 3);
263 print "ok $test\n"; $test++;
264
265 $_ = "";
266 eval 's/(?:)/"ok $test" . "${\q||}".<<\END/e;
267  - heredoc after "" in s/// in eval
268 END
269 ';
270 print $_ || "not ok $test\n"; $test++;
271
272 $_ = "";
273 eval 's|(?:)|"ok $test" . "${\<<\END}"
274  - heredoc in "" in multiline s///e in eval
275 END
276 |e
277 ';
278 print $_ || "not ok $test\n"; $test++;
279
280 $_ = "";
281 eval "s/(?:)/<<foo/e #\0
282 ok $test - null on same line as heredoc in s/// in eval
283 foo
284 ";
285 print $_ || "not ok $test\n"; $test++;
286
287 $_ = "";
288 eval ' s/(?:)/"${\<<END}"/e;
289 ok $test - heredoc in "" in single-line s///e in eval
290 END
291 ';
292 print $_ || "not ok $test\n"; $test++;
293
294 $_ = "";
295 s|(?:)|"${\<<END}"
296 ok $test - heredoc in "" in multiline s///e outside eval
297 END
298 |e;
299 print $_ || "not ok $test\n"; $test++;
300
301 $_ = "not ok $test - s/// in s/// pattern\n";
302 s/${s|||;\""}not //;
303 print; $test++;
304
305 /(?{print <<END
306 ok $test - here-doc in re-eval
307 END
308 })/; $test++;
309
310 eval '/(?{print <<END
311 ok $test - here-doc in re-eval in string eval
312 END
313 })/'; $test++;
314
315 eval 'print qq ;ok $test - eval ending with semicolon\n;'
316   or print "not ok $test - eval ending with semicolon\n"; $test++;
317
318 print "not " unless qr/(?{<<END})/ eq '(?^:(?{<<END}))';
319 foo
320 END
321 print "ok $test - here-doc in single-line re-eval\n"; $test++;
322
323 $_ = qr/(?{"${<<END}"
324 foo
325 END
326 })/;
327 print "not " unless /foo/;
328 print "ok $test - here-doc in quotes in multiline re-eval\n"; $test++;
329
330 eval 's//<<END/e if 0; $_ = "a
331 END
332 b"';
333 print "not " if $_ =~ /\n\n/;
334 print "ok $test - eval 's//<<END/' does not leave extra newlines\n"; $test++;
335
336 $_ = a;
337 eval "s/a/'b\0'#/e";
338 print 'not ' unless $_ eq "b\0";
339 print "ok $test - # after null in s/// repl\n"; $test++;
340
341 s//"#" . <<END/e;
342 foo
343 END
344 print "ok $test - s//'#' . <<END/e\n"; $test++;
345
346 eval "s//3}->{3/e";
347 print "not " unless $@;
348 print "ok $test - s//3}->{3/e\n"; $test++;
349
350 $_ = "not ok $test";
351 $x{3} = "not ";
352 eval 's/${\%x}{3}//e';
353 print "$_ - s//\${\\%x}{3}/e\n"; $test++;
354
355 eval 's/${foo#}//e';
356 print "not " unless $@;
357 print "ok $test - s/\${foo#}//e\n"; $test++;
358
359 eval 'warn ({$_ => 1} + 1) if 0';
360 print "not " if $@;
361 print "ok $test - listop({$_ => 1} + 1)\n"; $test++;
362 print "# $@" if $@;
363
364 for(qw< require goto last next redo dump >) {
365     eval "sub { $_ foo << 2 }";
366     print "not " if $@;
367     print "ok ", $test++, " - [perl #105924] $_ WORD << ...\n";
368     print "# $@" if $@;
369 }
370
371 # http://rt.perl.org/rt3/Ticket/Display.html?id=56880
372 my $counter = 0;
373 eval 'v23: $counter++; goto v23 unless $counter == 2';
374 print "not " unless $counter == 2;
375 print "ok $test - Use v[0-9]+ as a label\n"; $test++;
376 $counter = 0;
377 eval 'v23 : $counter++; goto v23 unless $counter == 2';
378 print "not " unless $counter == 2;
379 print "ok $test - Use v[0-9]+ as a label with space before colon\n"; $test++;
380  
381 my $output = "";
382 eval "package v10::foo; sub test2 { return 'v10::foo' }
383       package v10; sub test { return v10::foo::test2(); }
384       package main; \$output = v10::test(); "; 
385 print "not " unless $output eq 'v10::foo';
386 print "ok $test - call a function in package v10::foo\n"; $test++;
387
388 print "not " unless (1?v65:"bar") eq 'A';
389 print "ok $test - colon detection after vstring does not break ? vstring :\n"; $test++;
390
391 # Test pyoq ops with comments before the first delim
392 q # comment
393  "b"#
394   eq 'b' or print "not ";
395 print "ok $test - q <comment> <newline> ...\n"; $test++;
396 qq # comment
397  "b"#
398   eq 'b' or print "not ";
399 print "ok $test - qq <comment> <newline> ...\n"; $test++;
400 qw # comment
401  "b"#
402   [0] eq 'b' or print "not ";
403 print "ok $test - qw <comment> <newline> ...\n"; $test++;
404 "b" =~ m # comment
405  "b"#
406    or print "not ";
407 print "ok $test - m <comment> <newline> ...\n"; $test++;
408 qr # comment
409  "b"#
410    eq qr/b/ or print "not ";
411 print "ok $test - qr <comment> <newline> ...\n"; $test++;
412 $_ = "a";
413 s # comment
414  [a] #
415  [b] #
416  ;
417 print "not " unless $_ eq 'b';
418 print "ok $test - s <comment> <newline> ...\n"; $test++;
419 $_ = "a";
420 tr # comment
421  [a] #
422  [b] #
423  ;
424 print "not " unless $_ eq 'b';
425 print "ok $test - tr <comment> <newline> ...\n"; $test++;
426 $_ = "a";
427 y # comment
428  [a] #
429  [b] #
430  ;
431 print "not " unless $_ eq 'b';
432 print "ok $test - y <comment> <newline> ...\n"; $test++;
433
434 print "not " unless (time
435                      =>) eq time=>;
436 print "ok $test - => quotes keywords across lines\n"; $test++;