This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Basic tests for UTF-8 vars.
authorBrian Fraser <fraserbn@gmail.com>
Tue, 5 Jul 2011 22:24:41 +0000 (19:24 -0300)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 6 Oct 2011 20:01:04 +0000 (13:01 -0700)
MANIFEST
t/uni/parser.t [new file with mode: 0644]

index c3c52a0..50d5ac5 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5242,6 +5242,7 @@ t/uni/latin2.t                    See if Unicode in latin2 works
 t/uni/lex_utf8.t               See if Unicode in lexer works
 t/uni/lower.t                  See if Unicode casing works
 t/uni/overload.t               See if Unicode overloading works
+t/uni/parser.t                 See if Unicode is handled correctly by the parser
 t/uni/sprintf.t                        See if Unicode sprintf works
 t/uni/tie.t                    See if Unicode tie works
 t/uni/title.t                  See if Unicode casing works
diff --git a/t/uni/parser.t b/t/uni/parser.t
new file mode 100644 (file)
index 0000000..fa6b290
--- /dev/null
@@ -0,0 +1,93 @@
+#!./perl
+
+# Checks if the parser behaves correctly in edge cases
+# (including weird syntax errors)
+
+BEGIN {
+    require './test.pl';
+}
+
+plan (tests => 33);
+
+use utf8;
+use open qw( :utf8 :std );
+
+ok *tèst, "*main::tèst", "sanity check.";
+ok $::{"tèst"}, "gets the right glob in the stash.";
+
+my $glob_by_sub = sub { *main::method }->();
+
+is *main::method, "*main::method", "glob stringy works";
+is "" . *main::method, "*main::method", "glob stringify-through-concat works";
+is $glob_by_sub, "*main::method", "glob stringy works";
+is "" . $glob_by_sub, "*main::method", "";
+
+sub gimme_glob {
+    no strict 'refs';
+    is *{$_[0]}, "*main::$_[0]";
+    *{$_[0]};
+}
+
+is "" . gimme_glob("下郎"), "*main::下郎";
+$a = *下郎;
+is "" . $a, "*main::下郎";
+
+*{gimme_glob("下郎")} = sub {};
+
+{
+    ok defined *{"下郎"}{CODE};
+    ok !defined *{"\344\270\213\351\203\216"}{CODE};
+}
+
+$Lèon = 1;
+is ${*Lèon{SCALAR}}, 1, "scalar define in the right glob,";
+ok !${*{"L\303\250on"}{SCALAR}}, "..and nothing in the wrong one.";
+
+my $a = "foo" . chr(190);
+my $b = $a    . chr(256);
+chop $b; # $b is $a with utf8 on
+
+is $a, $b, '$a equals $b';
+
+*$b = sub { 5 };
+
+is eval { main->$a }, 5, q!$a can call $b's sub!;
+ok !$@, "..and there's no error.";
+
+my $c = $b;
+utf8::encode($c);
+ok $b ne $c, '$b unequal $c';
+eval { main->$c };
+ok $@, q!$c can't call $b's sub.!;
+
+# Now define another sub under the downgraded name:
+*$a = sub { 6 };
+# Call it:
+is eval { main->$a }, 6, "Adding a new sub to *a and calling it works,";
+ok !$@, "..without errors.";
+eval { main->$c };
+ok $@, "but it's still unreachable through *c";
+
+*$b = \10;
+is ${*$a{SCALAR}}, 10;
+is ${*$b{SCALAR}}, 10;
+is ${*$c{SCALAR}}, undef;
+
+opendir FÒÒ, ".";
+closedir FÒÒ;
+::ok($::{"FÒÒ"}, "Bareword generates the right glob.");
+::ok(!$::{"F\303\222\303\222"});
+
+sub участники { 1 }
+
+ok $::{"участники"}, "non-const sub declarations generate the right glob";
+ok *{$::{"участники"}}{CODE};
+is *{$::{"участники"}}{CODE}->(), 1;
+
+TODO: {
+    our $TODO = "our isn't clean in this branch";
+    our $問 = 10;
+    is $問, 10;
+    is $main::問, 10;
+    is ${"main::\345\225\217"}, undef;
+}