t/comp/opsubs.t

   1 #!./perl -T
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use warnings;
   9 use strict;
  10 $|++;
  11
  12 require "./test.pl";
  13
  14 plan(tests => 36);
  15
  16 use vars qw($TODO);
  17
  18 =pod
  19
  20 Even if you have a C<sub q{}>, calling C<q()> will be parsed as the
  21 C<q()> operator.  Calling C<&q()> or C<main::q()> gets you the function.
  22 This test verifies this behavior for nine different operators.
  23
  24 =cut
  25
  26 sub m  { return "m-".shift }
  27 sub q  { return "q-".shift }
  28 sub qq { return "qq-".shift }
  29 sub qr { return "qr-".shift }
  30 sub qw { return "qw-".shift }
  31 sub qx { return "qx-".shift }
  32 sub s  { return "s-".shift }
  33 sub tr { return "tr-".shift }
  34 sub y  { return "y-".shift }
  35
  36 # m operator
  37 can_ok( 'main', "m" );
  38 SILENCE_WARNING: { # Complains because $_ is undef
  39     no warnings;
  40     isnt( m('unqualified'), "m-unqualified", "m('unqualified') is oper" );
  41 }
  42 is( main::m('main'), "m-main", "main::m() is func" );
  43 is( &m('amper'), "m-amper", "&m() is func" );
  44
  45 # q operator
  46 can_ok( 'main', "q" );
  47 isnt( q('unqualified'), "q-unqualified", "q('unqualified') is oper" );
  48 is( main::q('main'), "q-main", "main::q() is func" );
  49 is( &q('amper'), "q-amper", "&q() is func" );
  50
  51 # qq operator
  52 can_ok( 'main', "qq" );
  53 isnt( qq('unqualified'), "qq-unqualified", "qq('unqualified') is oper" );
  54 is( main::qq('main'), "qq-main", "main::qq() is func" );
  55 is( &qq('amper'), "qq-amper", "&qq() is func" );
  56
  57 # qr operator
  58 can_ok( 'main', "qr" );
  59 isnt( qr('unqualified'), "qr-unqualified", "qr('unqualified') is oper" );
  60 is( main::qr('main'), "qr-main", "main::qr() is func" );
  61 is( &qr('amper'), "qr-amper", "&qr() is func" );
  62
  63 # qw operator
  64 can_ok( 'main', "qw" );
  65 isnt( qw('unqualified'), "qw-unqualified", "qw('unqualified') is oper" );
  66 is( main::qw('main'), "qw-main", "main::qw() is func" );
  67 is( &qw('amper'), "qw-amper", "&qw() is func" );
  68
  69 # qx operator
  70 can_ok( 'main', "qx" );
  71 eval "qx('unqualified'".
  72      ($^O eq 'MSWin32' ? " 2>&1)" : ")");
  73 SKIP: {
  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 }
  80 is( main::qx('main'), "qx-main", "main::qx() is func" );
  81 is( &qx('amper'), "qx-amper", "&qx() is func" );
  82
  83 # s operator
  84 can_ok( 'main', "s" );
  85 eval "s('unqualified')";
  86 like( $@, qr/^Substitution replacement not terminated/, "s('unqualified') doesn't work" );
  87 is( main::s('main'), "s-main", "main::s() is func" );
  88 is( &s('amper'), "s-amper", "&s() is func" );
  89
  90 # tr operator
  91 can_ok( 'main', "tr" );
  92 eval "tr('unqualified')";
  93 like( $@, qr/^Transliteration replacement not terminated/, "tr('unqualified') doesn't work" );
  94 is( main::tr('main'), "tr-main", "main::tr() is func" );
  95 is( &tr('amper'), "tr-amper", "&tr() is func" );
  96
  97 # y operator
  98 can_ok( 'main', "y" );
  99 eval "y('unqualified')";
 100 like( $@, qr/^Transliteration replacement not terminated/, "y('unqualified') doesn't work" );
 101 is( main::y('main'), "y-main", "main::y() is func" );
 102 is( &y('amper'), "y-amper", "&y() is func" );
 103
 104 =pod
 105
 106 from 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