9enabled

source of perl for linux application,

EXPECT
ok1
########

--FILE-- abc.pm
package abc ;
use warnings 'misc' ;
use warnings::register;
sub check {
  print "ok1\n" if  warnings::enabled ;
  print "ok2\n" if  warnings::enabled("syntax") ;
  print "ok3\n" if  warnings::enabled("io") ;
  print "ok4\n" if  ! warnings::enabled("misc") ;
}
1;
--FILE-- 
use warnings 'syntax' ;
use abc ;
use warnings 'abc' ;
sub fred { use warnings 'io'  ; abc::check() }
fred() ;
EXPECT
ok1
ok2
ok3
ok4
########

--FILE-- abc.pm
package abc ;
use warnings 'misc' ;
use warnings::register;
sub check { warnings::warn("hello") }
1;
--FILE--
use abc;
use warnings "abc" ;
abc::check() ;
EXPECT
hello at - line 3
########

--FILE-- abc.pm
package abc ;
use warnings::register;
sub check { warnings::warn("hello") }
1;
--FILE--
use abc;
abc::check() ;
EXPECT
hello at - line 2
########

--FILE-- abc.pm
package abc ;
use warnings::register ;
sub check { warnings::warn("hello") }
1;
--FILE--
use abc;
use warnings qw( FATAL deprecated ) ;
eval {
    abc::check() ; 
  } ;
print "[[$@]]\n";
EXPECT
hello at - line 4
[[]]
########

--FILE-- abc.pm
package abc ;
use warnings::register ;
sub check { warnings::warn("hello") }
1;
--FILE--
use abc;
use warnings qw( FATAL abc ) ;
eval { 
  abc::check() ; 
  } ;
print "[[$@]]\n";
EXPECT
[[hello at - line 4
]]
########
-W
--FILE-- abc.pm
package abc ;
use warnings "io" ;
use warnings::register ;
sub check { 
  print "ok1\n" if warnings::enabled() ;
  print "ok2\n" if warnings::enabled("io") ;
  print "ok3\n" if warnings::enabled("all") ;
}
1;
--FILE-- 
no warnings;
use abc ;
abc::check() ;
EXPECT
ok1
ok2
ok3
########
-X
--FILE-- abc.pm
package abc ;
use warnings "io" ;
use warnings::register ;
sub check { 
  print "ok1\n" if !warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
}
1;
--FILE-- 
no warnings;
use abc ;
abc::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc.pm
package abc ;
use warnings "io" ;
use warnings::register ;
sub check { 
  print "ok1\n" if warnings::enabled() ;
  print "ok2\n" if warnings::enabled("io") ;
  print "ok3\n" if warnings::enabled("all") ;
}
1;
--FILE-- 
use warnings 'all';
use abc ;
abc::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc.pm
package abc ;
use warnings "io" ;
use warnings::register ;
sub check { 
  print "ok1\n" if !warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
}
1;
--FILE-- 
use abc ;
no warnings ;
abc::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc.pm
package abc ;
use warnings "io" ;
use warnings::register ;
sub check { 
  print "ok1\n" if !warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
  warnings::warnif("my message 1") ;
  warnings::warnif('abc', "my message 2") ;
  warnings::warnif('io', "my message 3") ;
  warnings::warnif('all', "my message 4") ;
}
1;
--FILE-- 
use abc ;
use warnings 'abc';
no warnings ;
abc::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc.pm
package abc ;
use warnings "io" ;
use warnings::register ;
sub check { 
  print "abc self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
  print "abc def"  . (warnings::enabled('def') ? "" : " not") . " enabled\n" ;
  print "abc all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
}
1;
--FILE-- def.pm
package def ;
use warnings "io" ;
use warnings::register ;
sub check { 
  print "def self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
  print "def abc"  . (warnings::enabled('abc') ? "" : " not") . " enabled\n" ;
  print "def all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
}
1;
--FILE-- 
use abc ;
use def ;
use warnings 'abc';
abc::check() ;
def::check() ;
no warnings 'abc'  ;
use warnings 'def'  ;
abc::check() ;
def::check() ;
use warnings 'abc'  ;
use warnings 'def'  ;
abc::check() ;
def::check() ;
no warnings 'abc'  ;
no warnings 'def'  ;
abc::check() ;
def::check() ;
use warnings;
abc::check() ;
def::check() ;
no warnings 'abc' ;
abc::check() ;
def::check() ;
EXPECT
abc self enabled
abc def not enabled
abc all not enabled
def self not enabled
def abc enabled
def all not enabled
abc self not enabled
abc def enabled
abc all not enabled
def self enabled
def abc not enabled
def all not enabled
abc self enabled
abc def enabled
abc all not enabled
def self enabled
def abc enabled
def all not enabled
abc self not enabled
abc def not enabled
abc all not enabled
def self not enabled
def abc not enabled
def all not enabled
abc self enabled
abc def enabled
abc all enabled
def self enabled
def abc enabled
def all enabled
abc self not enabled
abc def enabled
abc all not enabled
def self enabled
def abc not enabled
def all not enabled
########
-w
--FILE-- abc.pm
package abc ;
no warnings ;
use warnings::register ;
sub check { 
  print "ok1\n" if warnings::enabled() ;
  print "ok2\n" if warnings::enabled("io") ;
  print "ok3\n" if warnings::enabled("all") ;
}
1;
--FILE-- 
use abc ;
abc::check() ;
EXPECT
ok1
ok2
ok3
########
-w
--FILE-- abc.pm
package abc ;
no warnings ;
use warnings::register ;
sub check { 
  print "ok1\n" if !warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
}
1;
--FILE-- 
use abc ;
use warnings 'abc';
no warnings ;
abc::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc.pm
package abc ;
no warnings ;
use warnings::register ;
sub check { 
  print "ok1\n" if !warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
  warnings::warnif("my message 1") ;
  warnings::warnif('abc', "my message 2") ;
  warnings::warnif('io', "my message 3") ;
  warnings::warnif('all', "my message 4") ;
}
1;
--FILE-- 
use abc ;
use warnings 'abc';
no warnings ;
BEGIN { $^W = 1 ; }
abc::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc.pm
package abc ;
no warnings ;
use warnings::register ;
sub check { 
  print "ok1\n" if !warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
}
1;
--FILE-- 
use abc ;
use warnings 'abc';
no warnings ;
$^W = 1 ;
abc::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc.pm
$| = 1;
package abc ;
no warnings ;
use warnings::register ;
sub check { 
  print "ok1\n" if  warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
  print "ok4\n" if  warnings::enabled("abc") ;
  warnings::warn("my message 1") ;
  warnings::warnif("my message 2") ;
  warnings::warnif('abc', "my message 3") ;
  warnings::warnif('io', "my message 4") ;
  warnings::warnif('all', "my message 5") ;
}
sub in2 { no warnings ; check() }
sub in1 { no warnings ; in2() }
1;
--FILE-- 
use abc ;
use warnings 'abc';
abc::in1() ;
EXPECT
ok1
ok2
ok3
ok4
my message 1 at - line 3
my message 2 at - line 3
my message 3 at - line 3
########

--FILE-- def.pm
package def ;
no warnings ;
use warnings::register ;
sub check { 
  print "ok1\n" if  warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
  print "ok4\n" if  warnings::enabled("def") ;
  warnings::warn("my message 1") ;
  warnings::warnif("my message 2") ;
  warnings::warnif('def', "my message 3") ;
  warnings::warnif('io', "my message 4") ;
  warnings::warnif('all', "my message 5") ;
}
sub in2 { no warnings ; check() }
sub in1 { no warnings ; in2() }
1;
--FILE-- abc.pm
$| = 1;
package abc ;
use def ;
use warnings 'def';
sub in1 { def::in1() ; }
1;
--FILE-- 
use abc ;
no warnings;
abc::in1() ;
EXPECT
ok1
ok2
ok3
ok4
my message 1 at abc.pm line 5
my message 2 at abc.pm line 5
my message 3 at abc.pm line 5
########

--FILE-- def.pm
$| = 1;
package def ;
no warnings ;
use warnings::register ;
require Exporter;
@ISA = qw( Exporter ) ;
@EXPORT = qw( in1 ) ;
sub check { 
  print "ok1\n" if  warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
  print "ok4\n" if  warnings::enabled("abc") ;
  print "ok5\n" if !warnings::enabled("def") ;
  warnings::warn("my message 1") ;
  warnings::warnif("my message 2") ;
  warnings::warnif('abc', "my message 3") ;
  warnings::warnif('def', "my message 4") ;
  warnings::warnif('io', "my message 5") ;
  warnings::warnif('all', "my message 6") ;
}
sub in2 { no warnings ; check() }
sub in1 { no warnings ; in2() }
1;
--FILE-- abc.pm
package abc ;
use warnings::register ;
use def ;
#@ISA = qw(def) ;
1;
--FILE-- 
use abc ;
no warnings;
use warnings 'abc';
abc::in1() ;
EXPECT
ok2
ok3
ok4
ok5
my message 1 at - line 4
my message 3 at - line 4
########

--FILE-- def.pm
package def ;
no warnings ;
use warnings::register ;

sub new
{
    my $class = shift ;
    bless [], $class ;
}

sub check 
{ 
  my $self = shift ;
  print "ok1\n" if !warnings::enabled() ;
  print "ok2\n" if !warnings::enabled("io") ;
  print "ok3\n" if !warnings::enabled("all") ;
  print "ok4\n" if  warnings::enabled("abc") ;
  print "ok5\n" if !warnings::enabled("def") ;
  print "ok6\n" if  warnings::enabled($self) ;

  warnings::warn("my message 1") ;
  warnings::warn($self, "my message 2") ;

  warnings::warnif("my message 3") ;
  warnings::warnif('abc', "my message 4") ;
  warnings::warnif('def', "my message 5") ;
  warnings::warnif('io', "my message 6") ;
  warnings::warnif('all', "my message 7") ;
  warnings::warnif($self, "my message 8") ;
}
sub in2 
{
  no warnings ; 
  my $self = shift ;
  $self->check() ;
}
sub in1 
{ 
  no warnings ;
  my $self = shift ;
  $self->in2();
}
1;
--FILE-- abc.pm
$| = 1;
package abc ;
use warnings::register ;
use def ;
@ISA = qw(def) ;
sub new
{
    my $class = shift ;
    bless [], $class ;
}

1;
--FILE-- 
use abc ;
no warnings;
use warnings 'abc';
$a = new abc ;
$a->in1() ;
print "**\n";
$b = new def ;
$b->in1() ;
EXPECT
ok1
ok2
ok3
ok4
ok5
ok6
my message 1 at - line 5
my message 2 at - line 5
my message 4 at - line 5
my message 8 at - line 5
**
ok1
ok2
ok3
ok4
ok5
my message 1 at - line 8
my message 2 at - line 8
my message 4 at - line 8
########

--FILE--
# test for bug [perl #15395]
my ( $warn_cat, # warning category we'll try to control
     $warn_msg, # the error message to catch
);

package SomeModule;
use warnings::register;

BEGIN {
    $warn_cat = __PACKAGE__;
    $warn_msg = 'from ' . __PACKAGE__;
}

# a sub that generates a random warning
sub gen_warning {
    warnings::warnif( $warn_msg );
}

package ClientModule;
# use SomeModule; (would go here)
our @CARP_NOT = ( $warn_cat ); # deliver warnings to *our* client

# call_warner provokes a warning.  It is delivered to its caller,
# who should also be able to control it
sub call_warner {
    SomeModule::gen_warning();
}

# user

package main;
my $warn_line = __LINE__ + 3; # this line should be in the error message
eval {
    use warnings FATAL => $warn_cat; # we want to know if this works
    ClientModule::call_warner();
};

# have we caught an error, and is it the one we generated?
print "ok1\n" if $@ =~ /$warn_msg/;

# does it indicate the right line?
print "ok2\n" if $@ =~ /line $warn_line/; 
EXPECT
ok1
ok2