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