xref: /openbsd-src/gnu/usr.bin/perl/cpan/Module-Loaded/t/01_Module-Loaded.t (revision 898184e3e61f9129feb5978fad5a8c6865f00b92)
1*b39c5158Smillertuse strict;
2*b39c5158Smillertuse less;
3*b39c5158Smillertuse Test::More  'no_plan';
4*b39c5158Smillert
5*b39c5158Smillertmy $Class   = 'Module::Loaded';
6*b39c5158Smillertmy @Funcs   = qw[mark_as_loaded mark_as_unloaded is_loaded];
7*b39c5158Smillertmy $Mod     = 'Foo::Bar'.$$;
8*b39c5158Smillertmy $Strict  = $ENV{'PERL_CORE'} ? 'less' : 'strict';
9*b39c5158Smillert
10*b39c5158Smillert### load the thing
11*b39c5158Smillert{   use_ok( $Class );
12*b39c5158Smillert    can_ok( $Class, @Funcs );
13*b39c5158Smillert}
14*b39c5158Smillert
15*b39c5158Smillert{   ok( !is_loaded($Mod),       "$Mod not loaded yet" );
16*b39c5158Smillert    ok( mark_as_loaded($Mod),   "   $Mod now marked as loaded" );
17*b39c5158Smillert    is( is_loaded($Mod), $0,    "   $Mod is loaded from $0" );
18*b39c5158Smillert
19*b39c5158Smillert    my $rv = eval "require $Mod; 1";
20*b39c5158Smillert    ok( $rv,                    "$Mod required" );
21*b39c5158Smillert    ok( !$@,                    "   require did not die" );
22*b39c5158Smillert}
23*b39c5158Smillert
24*b39c5158Smillert### unload again
25*b39c5158Smillert{   ok( mark_as_unloaded($Mod), "$Mod now marked as unloaded" );
26*b39c5158Smillert    ok( !is_loaded($Mod),       "   $Mod now longer loaded" );
27*b39c5158Smillert
28*b39c5158Smillert    my $rv = eval "require $Mod; 1";
29*b39c5158Smillert    ok( !$rv,                   "$Mod require failed" );
30*b39c5158Smillert    ok( $@,                     "   require died" );
31*b39c5158Smillert    like( $@, qr/locate/,       "       with expected error" );
32*b39c5158Smillert}
33*b39c5158Smillert
34*b39c5158Smillert### check for an already loaded module
35*b39c5158Smillert{   my $where = is_loaded( $Strict );
36*b39c5158Smillert    ok( $where,                 "$Strict loaded" );
37*b39c5158Smillert    ok( mark_as_unloaded( $Strict ),
38*b39c5158Smillert                                "   $Strict unloaded" );
39*b39c5158Smillert
40*b39c5158Smillert    ### redefining subs, quell warnings
41*b39c5158Smillert    {   local $SIG{__WARN__} = sub {};
42*b39c5158Smillert        my $rv = eval "require $Strict; 1";
43*b39c5158Smillert        ok( $rv,                "$Strict loaded again" );
44*b39c5158Smillert    }
45*b39c5158Smillert
46*b39c5158Smillert    is( is_loaded( $Strict ), $where,
47*b39c5158Smillert                                "   $Strict is loaded" );
48*b39c5158Smillert}
49