Add NV_PRESERVES_UV.
[p5sagit/p5-mst-13.2.git] / t / base / lex.t
CommitLineData
8d063cd8 1#!./perl
2
0244c3a4 3print "1..46\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
10$x = $#; # this is the register $#
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
56print <<`EOS` . <<\EOF;
57echo ok 12
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
765cb2dc 133 eval "\$\cN = 24"; # Literal control character
134 if ($@ or ${"\cN"} != 24) { print "not " }
2b92dfce 135 print "ok 33\n";
136 if ($^N != 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 $ {"\cN\cXX"} = 119;
145 $^N = 5; # This should be an unused ^Var.
146 $N = 5;
147 # The second caret here should be interpreted as an xor
148 if (($^N^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 #
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;
169 $^N = 'Someother';
170 $ {^Nostril} = 'Someother 2';
171 $ {^M} = 'Someother 3';
172 package main;
173 print "not " unless $^N eq 'Someother';
174 print "ok 39\n";
175 print "not " unless $ {^Nostril} 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
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}