ext/autouse/t/autouse.t

   1 #!./perl
   2
   3 BEGIN {
   4     require Config;
   5     if ($Config::Config{'extensions'} !~ m!\bList/Util\b!){
   6         print "1..0 # Skip -- Perl configured without List::Util module\n";
   7         exit 0;
   8     }
   9 }
  10
  11 use Test::More tests => 12;
  12
  13 BEGIN {
  14     require autouse;
  15     eval {
  16         "autouse"->import('List::Util' => 'List::Util::first(&@)');
  17     };
  18     ok( !$@ );
  19
  20     eval {
  21         "autouse"->import('List::Util' => 'Foo::min');
  22     };
  23     ok( $@, qr/^autouse into different package attempted/ );
  24
  25     "autouse"->import('List::Util' => qw(max first(&@)));
  26 }
  27
  28 my @a = (1,2,3,4,5.5);
  29 is( max(@a), 5.5);
  30
  31
  32 # first() has a prototype of &@.  Make sure that's preserved.
  33 is( (first { $_ > 3 } @a), 4);
  34
  35
  36 # Example from the docs.
  37 use autouse 'Carp' => qw(carp croak);
  38
  39 {
  40     my @warning;
  41     local $SIG{__WARN__} = sub { push @warning, @_ };
  42     carp "this carp was predeclared and autoused\n";
  43     is( scalar @warning, 1 );
  44     like( $warning[0], qr/^this carp was predeclared and autoused\n/ );
  45
  46     eval { croak "It is but a scratch!" };
  47     like( $@, qr/^It is but a scratch!/);
  48 }
  49
  50
  51 # Test that autouse's lazy module loading works.
  52 use autouse 'Errno' => qw(EPERM);
  53
  54 my $mod_file = 'Errno.pm';   # just fine and portable for %INC
  55 ok( !exists $INC{$mod_file} );
  56 ok( EPERM ); # test if non-zero
  57 ok( exists $INC{$mod_file} );
  58
  59 use autouse Env => "something";
  60 eval { something() };
  61 like( $@, qr/^\Qautoused module Env has unique import() method/ );
  62
  63 # Check that UNIVERSAL.pm doesn't interfere with modules that don't use
  64 # Exporter and have no import() of their own.
  65 require UNIVERSAL;
  66 require File::Spec;
  67 unshift @INC, File::Spec->catdir('t', 'lib'), 'lib';
  68 autouse->import("MyTestModule" => 'test_function');
  69 my $ret = test_function();
  70 is( $ret, 'works' );
  71