From: Andy Lester <andy@petdance.com>
Date: Thu, 12 Aug 2004 11:31:03 +0000 (-0500)
Subject: Test for functions with operator names
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=02c3ec76152345b10b4b092ca94b7ac52e5b1d25;p=p5sagit%2Fp5-mst-13.2.git

Test for functions with operator names
Message-ID: <20040812163103.GA26687@petdance.com>

p4raw-id: //depot/perl@23215
---

diff --git a/MANIFEST b/MANIFEST
index b8f73c8..cdda307 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2295,6 +2295,7 @@ t/comp/cpp.t			See if C preprocessor works
 t/comp/decl.t			See if declarations work
 t/comp/hints.t			See if %^H works
 t/comp/multiline.t		See if multiline strings work
+t/comp/opsubs.t			See if q() etc. are not parsed as functions
 t/comp/our.t			Tests for our declaration
 t/comp/package.t		See if packages work
 t/comp/parser.t			See if the parser works in edge cases
diff --git a/t/comp/opsubs.t b/t/comp/opsubs.t
new file mode 100644
index 0000000..c76ce3c
--- /dev/null
+++ b/t/comp/opsubs.t
@@ -0,0 +1,117 @@
+#!./perl -T
+
+use warnings;
+use strict;
+$|++;
+
+=pod
+
+Even if you have a C<sub q{}>, calling C<q()> will be parsed as the
+C<q()> operator.  Calling C<&q()> or C<main::q()> gets you the function.
+This test verifies this behavior for nine different operators.
+
+=cut
+
+use Test::More tests => 36;
+
+sub m  { return "m-".shift }
+sub q  { return "q-".shift }
+sub qq { return "qq-".shift }
+sub qr { return "qr-".shift }
+sub qw { return "qw-".shift }
+sub qx { return "qx-".shift }
+sub s  { return "s-".shift }
+sub tr { return "tr-".shift }
+sub y  { return "y-".shift }
+
+# m operator
+can_ok( 'main', "m" );
+SILENCE_WARNING: { # Complains because $_ is undef
+    no warnings;
+    isnt( m('unqualified'), "m-unqualified", "m('unqualified') is oper" );
+}
+is( main::m('main'), "m-main", "main::m() is func" );
+is( &m('amper'), "m-amper", "&m() is func" );
+
+# q operator
+can_ok( 'main', "q" );
+isnt( q('unqualified'), "q-unqualified", "q('unqualified') is oper" );
+is( main::q('main'), "q-main", "main::q() is func" );
+is( &q('amper'), "q-amper", "&q() is func" );
+
+# qq operator
+can_ok( 'main', "qq" );
+isnt( qq('unqualified'), "qq-unqualified", "qq('unqualified') is oper" );
+is( main::qq('main'), "qq-main", "main::qq() is func" );
+is( &qq('amper'), "qq-amper", "&qq() is func" );
+
+# qr operator
+can_ok( 'main', "qr" );
+isnt( qr('unqualified'), "qr-unqualified", "qr('unqualified') is oper" );
+is( main::qr('main'), "qr-main", "main::qr() is func" );
+is( &qr('amper'), "qr-amper", "&qr() is func" );
+
+# qw operator
+can_ok( 'main', "qw" );
+isnt( qw('unqualified'), "qw-unqualified", "qw('unqualified') is oper" );
+is( main::qw('main'), "qw-main", "main::qw() is func" );
+is( &qw('amper'), "qw-amper", "&qw() is func" );
+
+# qx operator
+can_ok( 'main', "qx" );
+eval "qx('unqualified')";
+like( $@, qr/^Insecure/, "qx('unqualified') doesn't work" );
+is( main::qx('main'), "qx-main", "main::qx() is func" );
+is( &qx('amper'), "qx-amper", "&qx() is func" );
+
+# s operator
+can_ok( 'main', "s" );
+eval "s('unqualified')";
+like( $@, qr/^Substitution replacement not terminated/, "s('unqualified') doesn't work" );
+is( main::s('main'), "s-main", "main::s() is func" );
+is( &s('amper'), "s-amper", "&s() is func" );
+
+# tr operator
+can_ok( 'main', "tr" );
+eval "tr('unqualified')";
+like( $@, qr/^Transliteration replacement not terminated/, "tr('unqualified') doesn't work" );
+is( main::tr('main'), "tr-main", "main::tr() is func" );
+is( &tr('amper'), "tr-amper", "&tr() is func" );
+
+# y operator
+can_ok( 'main', "y" );
+eval "y('unqualified')";
+like( $@, qr/^Transliteration replacement not terminated/, "y('unqualified') doesn't work" );
+is( main::y('main'), "y-main", "main::y() is func" );
+is( &y('amper'), "y-amper", "&y() is func" );
+
+=pod
+
+from irc://irc.perl.org/p5p 2004/08/12
+
+ <kane-xs>  bug or feature?
+ <purl>     You decide!!!!
+ <kane-xs>  [kane@coke ~]$ perlc -le'sub y{1};y(1)'
+ <kane-xs>  Transliteration replacement not terminated at -e line 1.
+ <Nicholas> bug I think
+ <kane-xs>  i'll perlbug
+ <rgs>      feature
+ <kane-xs>  smiles at rgs
+ <kane-xs>  done
+ <rgs>      will be closed at not a bug,
+ <rgs>      like the previous reports of this one
+ <Nicholas> feature being first class and second class keywords?
+ <rgs>      you have similar ones with q, qq, qr, qx, tr, s and m
+ <rgs>      one could say 1st class keywords, yes
+ <rgs>      and I forgot qw
+ <kane-xs>  hmm silly...
+ <Nicholas> it's acutally operators, isn't it?
+ <Nicholas> as in you can't call a subroutine with the same name as an
+            operator unless you have the & ?
+ <kane-xs>  or fqpn (fully qualified package name)
+ <kane-xs>  main::y() works just fine
+ <kane-xs>  as does &y; but not y()
+ <Andy>     If that's a feature, then let's write a test that it continues
+            to work like that.
+
+=cut