Suppress a few compilation warnings in pp_hot.c.
[p5sagit/p5-mst-13.2.git] / t / base / lex.t
1 #!./perl
2
3 print "1..54\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 = $#;        # this is the register $#
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 <<;   # Yow!
73 ok 18
74
75 # previous line intentionally left blank.
76
77 print <<E1 eq "foo\n\n" ? "ok 19\n" : "not ok 19\n";
78 @{[ <<E2 ]}
79 foo
80 E2
81 E1
82
83 print <<E1 eq "foo\n\n" ? "ok 20\n" : "not ok 20\n";
84 @{[
85   <<E2
86 foo
87 E2
88 ]}
89 E1
90
91 $foo = FOO;
92 $bar = BAR;
93 $foo{$bar} = BAZ;
94 $ary[0] = ABC;
95
96 print "$foo{$bar}" eq "BAZ" ? "ok 21\n" : "not ok 21\n";
97
98 print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 22\n" : "not ok 22\n";
99 print "${foo{$bar}}" eq "BAZ" ? "ok 23\n" : "not ok 23\n";
100
101 print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n";
102 print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n";
103 print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n";
104
105 # MJD 19980425
106 ($X, @X) = qw(a b c d); 
107 print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n";
108 print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n";
109
110 print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
111
112
113 $foo = "not ok 30\n";
114 $foo =~ s/^not /substr(<<EOF, 0, 0)/e;
115   Ignored
116 EOF
117 print $foo;
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?
130   if (eval "\$ {\cX}" != 17 or $@) { print "not "  }
131   print "ok 32\n";
132
133   eval "\$\cQ = 24";                 # Literal control character
134   if ($@ or ${"\cQ"} != 24) {  print "not "  }
135   print "ok 33\n";
136   if ($^Q != 24) {  print "not "  }  # Control character escape sequence
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 }
144   $ {"\cQ\cXX"} = 119; 
145   $^Q = 5; #  This should be an unused ^Var.
146   $N = 5;
147   # The second caret here should be interpreted as an xor
148   if (($^Q^XX) != 3) { print "not " } 
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   # 
156
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;
169   $^Q = 'Someother';
170   $ {^Quixote} = 'Someother 2';
171   $ {^M} = 'Someother 3';
172   package main;
173   print "not " unless $^Q eq 'Someother';
174   print "ok 39\n";
175   print "not " unless $ {^Quixote} eq 'Someother 2';
176   print "ok 40\n";
177   print "not " unless $ {^M} eq 'Someother 3';
178   print "ok 41\n";
179
180   
181 }
182
183 # see if eval '', s///e, and heredocs mix
184
185 sub 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
192 my $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
200 EOT
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 }
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 }
248
249 # Tests 52-54
250 # => should only quote foo::bar if it isn't a real sub. AMS, 20010621
251
252 sub xyz::foo { "bar" }
253 my %str = (
254     foo      => 1,
255     xyz::foo => 1,
256     xyz::bar => 1,
257 );
258
259 my $test = 52;
260 print ((exists $str{foo}      ? "" : "not ")."ok $test\n"); ++$test;
261 print ((exists $str{bar}      ? "" : "not ")."ok $test\n"); ++$test;
262 print ((exists $str{xyz::bar} ? "" : "not ")."ok $test\n"); ++$test;