ext/List-Util/t/proto.t

   1 #!./perl
   2
   3 BEGIN {
   4     unless (-d 'blib') {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7         require Config; import Config;
   8         keys %Config; # Silence warning
   9         if ($Config{extensions} !~ /\bList\/Util\b/) {
  10             print "1..0 # Skip: List::Util was not built\n";
  11             exit 0;
  12         }
  13     }
  14 }
  15
  16 use Scalar::Util ();
  17 use Test::More  (grep { /set_prototype/ } @Scalar::Util::EXPORT_FAIL)
  18                         ? (skip_all => 'set_prototype requires XS version')
  19                         : (tests => 13);
  20
  21 Scalar::Util->import('set_prototype');
  22
  23 sub f { }
  24 is( prototype('f'),     undef,  'no prototype');
  25
  26 $r = set_prototype(\&f,'$');
  27 is( prototype('f'),     '$',    'set prototype');
  28 is( $r,                 \&f,    'return value');
  29
  30 set_prototype(\&f,undef);
  31 is( prototype('f'),     undef,  'remove prototype');
  32
  33 set_prototype(\&f,'');
  34 is( prototype('f'),     '',     'empty prototype');
  35
  36 sub g (@) { }
  37 is( prototype('g'),     '@',    '@ prototype');
  38
  39 set_prototype(\&g,undef);
  40 is( prototype('g'),     undef,  'remove prototype');
  41
  42 sub stub;
  43 is( prototype('stub'),  undef,  'non existing sub');
  44
  45 set_prototype(\&stub,'$$$');
  46 is( prototype('stub'),  '$$$',  'change non existing sub');
  47
  48 sub f_decl ($$$$);
  49 is( prototype('f_decl'),        '$$$$', 'forward declaration');
  50
  51 set_prototype(\&f_decl,'\%');
  52 is( prototype('f_decl'),        '\%',   'change forward declaration');
  53
  54 eval { &set_prototype( 'f', '' ); };
  55 print "not " unless
  56 ok($@ =~ /^set_prototype: not a reference/,     'not a reference');
  57
  58 eval { &set_prototype( \'f', '' ); };
  59 ok($@ =~ /^set_prototype: not a subroutine reference/,  'not a sub reference');