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
1 #!./perl
2
3 # Checks if the parser behaves correctly in edge case
4 # (including weird syntax errors)
5
6 BEGIN {
7     require './test.pl';
8 }
9
10 use 5.016;
11 use utf8;
12 use open qw( :utf8 :std );
13 no warnings qw(misc reserved);
14
15 plan (tests => 65850);
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
49 {
50    local $@;
51    use utf8;
52    eval '${☭asd} = 1';
53    like($@, qr/\QUnrecognized character/, q(the first character in ${...} isn't special))
54 }
55
56 # Checking that at least some of the special variables work
57 for 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.
69 for ( 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
140 for 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
156 for 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 }