3 # Uncomment this for testing, but don't leave it in for "production", as
4 # we've not yet verified that use works.
13 my ($got, $expected, $name) = @_;
16 print "not ok $test - $name # TODO: $::TODO\n";
19 print "not ok $test - $name\n";
21 my @caller = caller(1);
22 print "# Failed test at $caller[1] line $caller[2]\n";
24 print "# Got '$got'\n";
26 print "# Got undef\n";
28 print "# Expected $expected\n";
33 my ($got, $pattern, $name) = @_;
35 if (defined $got && $got =~ $pattern) {
37 print "ok $test - $name # TODO: $::TODO\n";
40 print "ok $test - $name\n";
42 # Principle of least surprise - maintain the expected interface, even
43 # though we aren't using it here (yet).
46 failed($got, $pattern, $name);
50 my ($got, $expect, $name) = @_;
52 if (defined $got && $got eq $expect) {
54 print "ok $test - $name # TODO: $::TODO\n";
57 print "ok $test - $name\n";
61 failed($got, "'$expect'", $name);
65 my ($got, $expect, $name) = @_;
67 if (defined $got && $got ne $expect) {
69 print "ok $test - $name # TODO: $::TODO\n";
72 print "ok $test - $name\n";
76 failed($got, "not '$expect'", $name);
80 my ($class, $method) = @_;
82 if (eval { $class->can($method) }) {
84 print "ok $test - $class->can('$method') # TODO: $::TODO\n";
87 print "ok $test - $class->can('$method')\n";
92 print "# Failed test at $caller[1] line $caller[2]\n";
93 print "# $class cannot $method\n";
99 Even if you have a C<sub q{}>, calling C<q()> will be parsed as the
100 C<q()> operator. Calling C<&q()> or C<main::q()> gets you the function.
101 This test verifies this behavior for nine different operators.
105 sub m { return "m-".shift }
106 sub q { return "q-".shift }
107 sub qq { return "qq-".shift }
108 sub qr { return "qr-".shift }
109 sub qw { return "qw-".shift }
110 sub qx { return "qx-".shift }
111 sub s { return "s-".shift }
112 sub tr { return "tr-".shift }
113 sub y { return "y-".shift }
116 can_ok( 'main', "m" );
117 SILENCE_WARNING: { # Complains because $_ is undef
119 isnt( m('unqualified'), "m-unqualified", "m('unqualified') is oper" );
121 is( main::m('main'), "m-main", "main::m() is func" );
122 is( &m('amper'), "m-amper", "&m() is func" );
125 can_ok( 'main', "q" );
126 isnt( q('unqualified'), "q-unqualified", "q('unqualified') is oper" );
127 is( main::q('main'), "q-main", "main::q() is func" );
128 is( &q('amper'), "q-amper", "&q() is func" );
131 can_ok( 'main', "qq" );
132 isnt( qq('unqualified'), "qq-unqualified", "qq('unqualified') is oper" );
133 is( main::qq('main'), "qq-main", "main::qq() is func" );
134 is( &qq('amper'), "qq-amper", "&qq() is func" );
137 can_ok( 'main', "qr" );
138 isnt( qr('unqualified'), "qr-unqualified", "qr('unqualified') is oper" );
139 is( main::qr('main'), "qr-main", "main::qr() is func" );
140 is( &qr('amper'), "qr-amper", "&qr() is func" );
143 can_ok( 'main', "qw" );
144 isnt( qw('unqualified'), "qw-unqualified", "qw('unqualified') is oper" );
145 is( main::qw('main'), "qw-main", "main::qw() is func" );
146 is( &qw('amper'), "qw-amper", "&qw() is func" );
149 can_ok( 'main', "qx" );
150 eval "qx('unqualified'".
151 ($^O eq 'MSWin32' ? " 2>&1)" : ")");
153 local $::TODO = $^O eq 'MSWin32' ? "Tainting of PATH not working of Windows" : $::TODO;
154 like( $@, qr/^Insecure/, "qx('unqualified') doesn't work" );
156 is( main::qx('main'), "qx-main", "main::qx() is func" );
157 is( &qx('amper'), "qx-amper", "&qx() is func" );
160 can_ok( 'main', "s" );
161 eval "s('unqualified')";
162 like( $@, qr/^Substitution replacement not terminated/, "s('unqualified') doesn't work" );
163 is( main::s('main'), "s-main", "main::s() is func" );
164 is( &s('amper'), "s-amper", "&s() is func" );
167 can_ok( 'main', "tr" );
168 eval "tr('unqualified')";
169 like( $@, qr/^Transliteration replacement not terminated/, "tr('unqualified') doesn't work" );
170 is( main::tr('main'), "tr-main", "main::tr() is func" );
171 is( &tr('amper'), "tr-amper", "&tr() is func" );
174 can_ok( 'main', "y" );
175 eval "y('unqualified')";
176 like( $@, qr/^Transliteration replacement not terminated/, "y('unqualified') doesn't work" );
177 is( main::y('main'), "y-main", "main::y() is func" );
178 is( &y('amper'), "y-amper", "&y() is func" );
182 from irc://irc.perl.org/p5p 2004/08/12
184 <kane-xs> bug or feature?
185 <purl> You decide!!!!
186 <kane-xs> [kane@coke ~]$ perlc -le'sub y{1};y(1)'
187 <kane-xs> Transliteration replacement not terminated at -e line 1.
188 <Nicholas> bug I think
189 <kane-xs> i'll perlbug
191 <kane-xs> smiles at rgs
193 <rgs> will be closed at not a bug,
194 <rgs> like the previous reports of this one
195 <Nicholas> feature being first class and second class keywords?
196 <rgs> you have similar ones with q, qq, qr, qx, tr, s and m
197 <rgs> one could say 1st class keywords, yes
198 <rgs> and I forgot qw
199 <kane-xs> hmm silly...
200 <Nicholas> it's acutally operators, isn't it?
201 <Nicholas> as in you can't call a subroutine with the same name as an
202 operator unless you have the & ?
203 <kane-xs> or fqpn (fully qualified package name)
204 <kane-xs> main::y() works just fine
205 <kane-xs> as does &y; but not y()
206 <Andy> If that's a feature, then let's write a test that it continues