3 # Checks if the parser behaves correctly in edge cases
4 # (including weird syntax errors)
13 use open qw( :utf8 :std );
15 ok *tèst, "*main::tèst", "sanity check.";
16 ok $::{"tèst"}, "gets the right glob in the stash.";
18 my $glob_by_sub = sub { *main::method }->();
20 is *main::method, "*main::method", "glob stringy works";
21 is "" . *main::method, "*main::method", "glob stringify-through-concat works";
22 is $glob_by_sub, "*main::method", "glob stringy works";
23 is "" . $glob_by_sub, "*main::method", "";
27 is *{$_[0]}, "*main::$_[0]";
31 is "" . gimme_glob("下郎"), "*main::下郎";
33 is "" . $a, "*main::下郎";
35 *{gimme_glob("下郎")} = sub {};
38 ok defined *{"下郎"}{CODE};
39 ok !defined *{"\344\270\213\351\203\216"}{CODE};
43 is ${*Lèon{SCALAR}}, 1, "scalar define in the right glob,";
44 ok !${*{"L\303\250on"}{SCALAR}}, "..and nothing in the wrong one.";
46 my $a = "foo" . chr(190);
47 my $b = $a . chr(256);
48 chop $b; # $b is $a with utf8 on
50 is $a, $b, '$a equals $b';
54 is eval { main->$a }, 5, q!$a can call $b's sub!;
55 ok !$@, "..and there's no error.";
59 ok $b ne $c, '$b unequal $c';
61 ok $@, q!$c can't call $b's sub.!;
63 # Now define another sub under the downgraded name:
66 is eval { main->$a }, 6, "Adding a new sub to *a and calling it works,";
67 ok !$@, "..without errors.";
69 ok $@, "but it's still unreachable through *c";
72 is ${*$a{SCALAR}}, 10;
73 is ${*$b{SCALAR}}, 10;
74 is ${*$c{SCALAR}}, undef;
78 ::ok($::{"FÒÒ"}, "Bareword generates the right glob.");
79 ::ok(!$::{"F\303\222\303\222"});
83 ok $::{"участники"}, "non-const sub declarations generate the right glob";
84 ok *{$::{"участники"}}{CODE};
85 is *{$::{"участники"}}{CODE}->(), 1;
89 is grep({ $_ eq "\x{539f}" } keys %::), 1, "Constant subs generate the right glob.";
90 is grep({ $_ eq "\345\216\237" } keys %::), 0;
92 #These should probably go elsewhere.
93 eval q{ sub wròng1 (_$); wròng1(1,2) };
94 like( $@, qr/Malformed prototype for main::wròng1/, 'Malformed prototype croak is clean.' );
96 eval q{ sub ча::ики ($__); ча::ики(1,2) };
97 like( $@, qr/Malformed prototype for ча::ики/ );
100 is $問, 10, "our works";
101 is $main::問, 10, "...as does getting the same variable through the fully qualified name";
102 is ${"main::\345\225\217"}, undef, "..and using the encoded form doesn't";
105 use charnames qw( :full );
107 eval qq! my \$\x{30cb} \N{DROMEDARY CAMEL} !;
108 $@ =~ s/eval \d+/eval 11/;
109 is $@, 'Unrecognized character \x{1f42a}; marked by <-- HERE after my $ニ <-- HERE near column 8 at (eval 11) line 1.
110 ', "'Unrecognized character' croak is UTF-8 clean";
112 eval "q\0foobar\0 \x{FFFF}+1";
113 $@ =~ s/eval \d+/eval 11/;
116 "Unrecognized character \\x{ffff}; marked by <-- HERE after q\0foobar\0 <-- HERE near column 11 at (eval 11) line 1.\n",
122 my $f = qq{(?{\$ネ+ 1; \x{1F42A} })};
123 eval { "a" =~ /^a$f/ };
125 $e =~ s/eval \d+/eval 11/;
128 "Unrecognized character \\x{1f42a}; marked by <-- HERE after (?{\$ネ+ 1; <-- HERE near column 13 at (eval 11) line 1.\n",
129 "Messages from a re-eval are UTF-8 clean"
132 $f = qq{(?{q\0foobar\0 \x{FFFF}+1 })};
133 eval { "a" =~ /^a$f/ };
135 $e =~ s/eval \d+/eval 11/;
138 "Unrecognized character \\x{ffff}; marked by <-- HERE after q\x{0}foobar\x{0} <-- HERE near column 16 at (eval 11) line 1.\n",
144 eval qq{\$ネ+ 1; \x{1F42A}};
145 $@ =~ s/eval \d+/eval 11/;
148 "Unrecognized character \\x{1f42a}; marked by <-- HERE after \$ネ+ 1; <-- HERE near column 8 at (eval 11) line 1.\n",
149 "Unrecognized character error doesn't cut off in the middle of characters"
157 for ( qw( my state our ) ) {
159 eval "$_ Foo $x = 1;";
160 like $@, qr/No such class Foo/u, "'No such class' warning for $_ is UTF-8 clean";
166 eval "our \$main::\x{30cb};";
167 like $@, qr!No package name allowed for variable \$main::\x{30cb} in "our"!, "'No such package name allowed for variable' is UTF-8 clean";
173 for ( qw( my state ) ) {
174 eval "$_ \$::\x{30cb};";
175 like $@, qr!"$_" variable \$::\x{30cb} can't be in a package!, qq!'"$_" variable %s can't be in a package' is UTF-8 clean!;
181 eval qq!print \x{30cb}, "comma""!;
182 like $@, qr/No comma allowed after filehandle/, "No comma allowed after filehandle triggers correctly for UTF-8 filehandles.";
185 # tests for "Bad name"
187 like( $@, qr/Bad name after Foo::/, 'Bad name after Foo::' );
189 like( $@, qr/Bad name after Foo'/, 'Bad name after Foo\'' );
193 my $malformed_to_be = "\x{c0}\x{a0}"; # Overlong sequence
194 CORE::evalbytes "use charnames ':full'; use utf8; my \$x = \"\\N{abc$malformed_to_be}\"";
195 like( $@, qr/Malformed UTF-8 character immediately after '\\N\{abc' at .* within string/, 'Malformed UTF-8 input to \N{}');