This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump version of Term::ReadLine
[perl5.git] / t / uni / variables.t
CommitLineData
07f72646
BF
1#!./perl
2
3# Checks if the parser behaves correctly in edge case
4# (including weird syntax errors)
5
6BEGIN {
7 require './test.pl';
8}
9
10use 5.016;
11use utf8;
12use open qw( :utf8 :std );
32833930 13no warnings qw(misc reserved);
07f72646 14
32833930 15plan (tests => 65850);
07f72646
BF
16
17# ${single:colon} should not be valid syntax
18{
19 no strict;
20
21 local $@;
22 eval "\${\x{30cd}single:\x{30cd}colon} = 1";
23 like($@,
24 qr/syntax error .* near "\x{30cd}single:/,
25 '${\x{30cd}single:\x{30cd}colon} should not be valid syntax'
26 );
27
28 local $@;
29 no utf8;
30 evalbytes '${single:colon} = 1';
31 like($@,
32 qr/syntax error .* near "single:/,
33 '...same with ${single:colon}'
34 );
35}
36
37# ${yadda'etc} and ${yadda::etc} should both work under strict
38{
39 local $@;
40 eval q<use strict; ${flark::fleem}>;
41 is($@, '', q<${package::var} works>);
42
43 local $@;
44 eval q<use strict; ${fleem'flark}>;
45 is($@, '', q<...as does ${package'var}>);
46}
47
48# The first character in ${...} should respect the rules
32833930 49{
07f72646
BF
50 local $@;
51 use utf8;
52 eval '${☭asd} = 1';
53 like($@, qr/\QUnrecognized character/, q(the first character in ${...} isn't special))
54}
32833930
BF
55
56# Checking that at least some of the special variables work
57for my $v (qw( ^V ; < > ( ) {^GLOBAL_PHASE} ^W _ 1 4 0 [ ] ! @ / \ = )) {
58 local $@;
59 evalbytes "\$$v;";
60 is $@, '', "No syntax error for \$$v";
61
62 local $@;
63 eval "use utf8; \$$v;";
64 is $@, '', "No syntax error for \$$v under use utf8";
65}
66
67# Checking if the Latin-1 range behaves as expected, and that the behavior is the
68# same whenever under strict or not.
69for ( 0x80..0xff ) {
70 no warnings 'closure';
71 my $chr = chr;
72 my $esc = sprintf("%X", ord $chr);
73 utf8::downgrade($chr);
74 if ($chr !~ /\p{XIDS}/u) {
75 is evalbytes "no strict; \$$chr = 10",
76 10,
77 sprintf("\\x%02x, part of the latin-1 range, is legal as a length-1 variable", $_);
78
79 utf8::upgrade($chr);
80 local $@;
81 eval "no strict; use utf8; \$$chr = 1";
82 like $@,
83 qr/\QUnrecognized character \x{\E\L$esc/,
84 sprintf("..but is illegal as a length-1 variable under use utf8", $_);
85 }
86 else {
87 {
88 no utf8;
89 local $@;
90 evalbytes "no strict; \$$chr = 1";
91 is($@, '', sprintf("\\x%02x, =~ \\p{XIDS}, latin-1, no utf8, no strict, is a valid length-1 variable", $_));
92
93 local $@;
94 evalbytes "use strict; \$$chr = 1";
95 is($@,
96 '',
97 sprintf("\\x%02x under no utf8 does not have to be required under strict, even though it matches XIDS", $_)
98 );
99
100 local $@;
101 evalbytes "\$a$chr = 1";
102 like($@,
103 qr/Unrecognized character /,
104 sprintf("...but under no utf8, it's not allowed in two-or-more character variables")
105 );
106
107 local $@;
108 evalbytes "\$a$chr = 1";
109 like($@,
110 qr/Unrecognized character /,
111 sprintf("...but under no utf8, it's not allowed in two-or-more character variables")
112 );
113 }
114 {
115 use utf8;
116 my $u = $chr;
117 utf8::upgrade($u);
118 local $@;
119 eval "no strict; \$$u = 1";
120 is($@, '', sprintf("\\x%02x, =~ \\p{XIDS}, UTF-8, use utf8, no strict, is a valid length-1 variable", $_));
121
122 local $@;
123 eval "use strict; \$$u = 1";
124 like($@,
125 qr/Global symbol "\$$u" requires explicit package name/,
126 sprintf("\\x%02x under utf8 has to be required under strict", $_)
127 );
128 }
129 }
130}
131
132{
133 use utf8;
134 my $ret = eval "my \$c\x{327} = 100; \$c\x{327}"; # c + cedilla
135 is($@, '', "ASCII character + combining character works as a variable name");
136 is($ret, 100, "...and returns the correct value");
137}
138
139# From Tom Christiansen's 'highly illegal variable names are now accidentally legal' mail
140for my $chr (
141 "\N{EM DASH}", "\x{F8FF}", "\N{POUND SIGN}", "\N{SOFT HYPHEN}",
142 "\N{THIN SPACE}", "\x{11_1111}", "\x{DC00}", "\N{COMBINING DIAERESIS}",
143 "\N{COMBINING ENCLOSING CIRCLE BACKSLASH}",
144 )
145{
146 no warnings 'non_unicode';
147 my $esc = sprintf("%x", ord $chr);
148 local $@;
149 eval "\$$chr = 1; \$$chr";
150 like($@,
151 qr/\QUnrecognized character \x{$esc};/,
152 "\\x{$esc} is illegal for a length-one identifier"
153 );
154}
155
156for my $i (0x100..0xffff) {
157 my $chr = chr($i);
158 my $esc = sprintf("%x", $i);
159 local $@;
160 eval "my \$$chr = q<test>; \$$chr;";
161 if ( $chr =~ /^\p{_Perl_IDStart}$/ ) {
162 is($@, '', sprintf("\\x{%04x} is XIDS, works as a length-1 variable", $i));
163 }
164 else {
165 like($@,
166 qr/\QUnrecognized character \x{$esc};/,
167 "\\x{$esc} isn't XIDS, illegal as a length-1 variable",
168 )
169 }
170}