1 | #!./perl -T
|
---|
2 |
|
---|
3 | use warnings;
|
---|
4 | use strict;
|
---|
5 | $|++;
|
---|
6 |
|
---|
7 | =pod
|
---|
8 |
|
---|
9 | Even if you have a C<sub q{}>, calling C<q()> will be parsed as the
|
---|
10 | C<q()> operator. Calling C<&q()> or C<main::q()> gets you the function.
|
---|
11 | This test verifies this behavior for nine different operators.
|
---|
12 |
|
---|
13 | =cut
|
---|
14 |
|
---|
15 | use Test::More tests => 36;
|
---|
16 |
|
---|
17 | sub m { return "m-".shift }
|
---|
18 | sub q { return "q-".shift }
|
---|
19 | sub qq { return "qq-".shift }
|
---|
20 | sub qr { return "qr-".shift }
|
---|
21 | sub qw { return "qw-".shift }
|
---|
22 | sub qx { return "qx-".shift }
|
---|
23 | sub s { return "s-".shift }
|
---|
24 | sub tr { return "tr-".shift }
|
---|
25 | sub y { return "y-".shift }
|
---|
26 |
|
---|
27 | # m operator
|
---|
28 | can_ok( 'main', "m" );
|
---|
29 | SILENCE_WARNING: { # Complains because $_ is undef
|
---|
30 | no warnings;
|
---|
31 | isnt( m('unqualified'), "m-unqualified", "m('unqualified') is oper" );
|
---|
32 | }
|
---|
33 | is( main::m('main'), "m-main", "main::m() is func" );
|
---|
34 | is( &m('amper'), "m-amper", "&m() is func" );
|
---|
35 |
|
---|
36 | # q operator
|
---|
37 | can_ok( 'main', "q" );
|
---|
38 | isnt( q('unqualified'), "q-unqualified", "q('unqualified') is oper" );
|
---|
39 | is( main::q('main'), "q-main", "main::q() is func" );
|
---|
40 | is( &q('amper'), "q-amper", "&q() is func" );
|
---|
41 |
|
---|
42 | # qq operator
|
---|
43 | can_ok( 'main', "qq" );
|
---|
44 | isnt( qq('unqualified'), "qq-unqualified", "qq('unqualified') is oper" );
|
---|
45 | is( main::qq('main'), "qq-main", "main::qq() is func" );
|
---|
46 | is( &qq('amper'), "qq-amper", "&qq() is func" );
|
---|
47 |
|
---|
48 | # qr operator
|
---|
49 | can_ok( 'main', "qr" );
|
---|
50 | isnt( qr('unqualified'), "qr-unqualified", "qr('unqualified') is oper" );
|
---|
51 | is( main::qr('main'), "qr-main", "main::qr() is func" );
|
---|
52 | is( &qr('amper'), "qr-amper", "&qr() is func" );
|
---|
53 |
|
---|
54 | # qw operator
|
---|
55 | can_ok( 'main', "qw" );
|
---|
56 | isnt( qw('unqualified'), "qw-unqualified", "qw('unqualified') is oper" );
|
---|
57 | is( main::qw('main'), "qw-main", "main::qw() is func" );
|
---|
58 | is( &qw('amper'), "qw-amper", "&qw() is func" );
|
---|
59 |
|
---|
60 | # qx operator
|
---|
61 | can_ok( 'main', "qx" );
|
---|
62 | eval "qx('unqualified')";
|
---|
63 | TODO: {
|
---|
64 | local $TODO = $^O eq 'MSWin32' ? "Tainting of PATH not working of Windows" : $TODO;
|
---|
65 | like( $@, qr/^Insecure/, "qx('unqualified') doesn't work" );
|
---|
66 | }
|
---|
67 | is( main::qx('main'), "qx-main", "main::qx() is func" );
|
---|
68 | is( &qx('amper'), "qx-amper", "&qx() is func" );
|
---|
69 |
|
---|
70 | # s operator
|
---|
71 | can_ok( 'main', "s" );
|
---|
72 | eval "s('unqualified')";
|
---|
73 | like( $@, qr/^Substitution replacement not terminated/, "s('unqualified') doesn't work" );
|
---|
74 | is( main::s('main'), "s-main", "main::s() is func" );
|
---|
75 | is( &s('amper'), "s-amper", "&s() is func" );
|
---|
76 |
|
---|
77 | # tr operator
|
---|
78 | can_ok( 'main', "tr" );
|
---|
79 | eval "tr('unqualified')";
|
---|
80 | like( $@, qr/^Transliteration replacement not terminated/, "tr('unqualified') doesn't work" );
|
---|
81 | is( main::tr('main'), "tr-main", "main::tr() is func" );
|
---|
82 | is( &tr('amper'), "tr-amper", "&tr() is func" );
|
---|
83 |
|
---|
84 | # y operator
|
---|
85 | can_ok( 'main', "y" );
|
---|
86 | eval "y('unqualified')";
|
---|
87 | like( $@, qr/^Transliteration replacement not terminated/, "y('unqualified') doesn't work" );
|
---|
88 | is( main::y('main'), "y-main", "main::y() is func" );
|
---|
89 | is( &y('amper'), "y-amper", "&y() is func" );
|
---|
90 |
|
---|
91 | =pod
|
---|
92 |
|
---|
93 | from irc://irc.perl.org/p5p 2004/08/12
|
---|
94 |
|
---|
95 | <kane-xs> bug or feature?
|
---|
96 | <purl> You decide!!!!
|
---|
97 | <kane-xs> [kane@coke ~]$ perlc -le'sub y{1};y(1)'
|
---|
98 | <kane-xs> Transliteration replacement not terminated at -e line 1.
|
---|
99 | <Nicholas> bug I think
|
---|
100 | <kane-xs> i'll perlbug
|
---|
101 | <rgs> feature
|
---|
102 | <kane-xs> smiles at rgs
|
---|
103 | <kane-xs> done
|
---|
104 | <rgs> will be closed at not a bug,
|
---|
105 | <rgs> like the previous reports of this one
|
---|
106 | <Nicholas> feature being first class and second class keywords?
|
---|
107 | <rgs> you have similar ones with q, qq, qr, qx, tr, s and m
|
---|
108 | <rgs> one could say 1st class keywords, yes
|
---|
109 | <rgs> and I forgot qw
|
---|
110 | <kane-xs> hmm silly...
|
---|
111 | <Nicholas> it's acutally operators, isn't it?
|
---|
112 | <Nicholas> as in you can't call a subroutine with the same name as an
|
---|
113 | operator unless you have the & ?
|
---|
114 | <kane-xs> or fqpn (fully qualified package name)
|
---|
115 | <kane-xs> main::y() works just fine
|
---|
116 | <kane-xs> as does &y; but not y()
|
---|
117 | <Andy> If that's a feature, then let's write a test that it continues
|
---|
118 | to work like that.
|
---|
119 |
|
---|
120 | =cut
|
---|