Commit | Line | Data |
---|---|---|
1a96a5b7 BF |
1 | #!./perl |
2 | ||
3 | # Checks if the parser behaves correctly in edge cases | |
4 | # (including weird syntax errors) | |
5 | ||
6 | BEGIN { | |
7 | require './test.pl'; | |
8 | } | |
9 | ||
108f32a5 | 10 | plan (tests => 37); |
1a96a5b7 BF |
11 | |
12 | use utf8; | |
13 | use open qw( :utf8 :std ); | |
14 | ||
15 | ok *tèst, "*main::tèst", "sanity check."; | |
16 | ok $::{"tèst"}, "gets the right glob in the stash."; | |
17 | ||
18 | my $glob_by_sub = sub { *main::method }->(); | |
19 | ||
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", ""; | |
24 | ||
25 | sub gimme_glob { | |
26 | no strict 'refs'; | |
27 | is *{$_[0]}, "*main::$_[0]"; | |
28 | *{$_[0]}; | |
29 | } | |
30 | ||
31 | is "" . gimme_glob("下郎"), "*main::下郎"; | |
32 | $a = *下郎; | |
33 | is "" . $a, "*main::下郎"; | |
34 | ||
35 | *{gimme_glob("下郎")} = sub {}; | |
36 | ||
37 | { | |
38 | ok defined *{"下郎"}{CODE}; | |
39 | ok !defined *{"\344\270\213\351\203\216"}{CODE}; | |
40 | } | |
41 | ||
42 | $Lèon = 1; | |
43 | is ${*Lèon{SCALAR}}, 1, "scalar define in the right glob,"; | |
44 | ok !${*{"L\303\250on"}{SCALAR}}, "..and nothing in the wrong one."; | |
45 | ||
46 | my $a = "foo" . chr(190); | |
47 | my $b = $a . chr(256); | |
48 | chop $b; # $b is $a with utf8 on | |
49 | ||
50 | is $a, $b, '$a equals $b'; | |
51 | ||
52 | *$b = sub { 5 }; | |
53 | ||
54 | is eval { main->$a }, 5, q!$a can call $b's sub!; | |
55 | ok !$@, "..and there's no error."; | |
56 | ||
57 | my $c = $b; | |
58 | utf8::encode($c); | |
59 | ok $b ne $c, '$b unequal $c'; | |
60 | eval { main->$c }; | |
61 | ok $@, q!$c can't call $b's sub.!; | |
62 | ||
63 | # Now define another sub under the downgraded name: | |
64 | *$a = sub { 6 }; | |
65 | # Call it: | |
66 | is eval { main->$a }, 6, "Adding a new sub to *a and calling it works,"; | |
67 | ok !$@, "..without errors."; | |
68 | eval { main->$c }; | |
69 | ok $@, "but it's still unreachable through *c"; | |
70 | ||
71 | *$b = \10; | |
72 | is ${*$a{SCALAR}}, 10; | |
73 | is ${*$b{SCALAR}}, 10; | |
74 | is ${*$c{SCALAR}}, undef; | |
75 | ||
76 | opendir FÒÒ, "."; | |
77 | closedir FÒÒ; | |
78 | ::ok($::{"FÒÒ"}, "Bareword generates the right glob."); | |
79 | ::ok(!$::{"F\303\222\303\222"}); | |
80 | ||
81 | sub участники { 1 } | |
82 | ||
83 | ok $::{"участники"}, "non-const sub declarations generate the right glob"; | |
84 | ok *{$::{"участники"}}{CODE}; | |
85 | is *{$::{"участники"}}{CODE}->(), 1; | |
86 | ||
3453414d BF |
87 | sub 原 () { 1 } |
88 | ||
89 | is grep({ $_ eq "\x{539f}" } keys %::), 1, "Constant subs generate the right glob."; | |
90 | is grep({ $_ eq "\345\216\237" } keys %::), 0; | |
91 | ||
108f32a5 BF |
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.' ); | |
95 | ||
96 | eval q{ sub ча::ики ($__); ча::ики(1,2) }; | |
97 | like( $@, qr/Malformed prototype for ча::ики/ ); | |
98 | ||
23b0eed2 BF |
99 | our $問 = 10; |
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"; |