xref: /openbsd-current/gnu/usr.bin/perl/t/lib/warnings/9enabled

Check warnings::enabled, warnings::warn and other functionality of
warnings.pm.

__END__

--FILE-- abc0.pm
package abc0 ;
use warnings "io" ;
print "ok1\n" if ! warnings::enabled('all') ;
print "ok2\n" if ! warnings::enabled("io") ;
1;
--FILE--
no warnings;
use abc0 ;
EXPECT
ok1
ok2
########

--FILE-- abc1.pm
package abc1 ;
no warnings ;
print "ok1\n" if !warnings::enabled('all') ;
print "ok2\n" if warnings::enabled("syntax") ;
1;
--FILE--
use warnings 'syntax' ;
use abc1 ;
EXPECT
ok1
ok2
########

--FILE-- abc2.pm
package abc2 ;
use warnings 'syntax' ;
print "ok1\n" if   warnings::enabled('io') ;
print "ok2\n" if ! warnings::enabled("syntax") ;
1;
--FILE--
use warnings 'io' ;
use abc2 ;
EXPECT
ok1
ok2
########

--FILE-- abc3
no warnings ;
print "ok1\n" if !warnings::enabled('all') ;
print "ok2\n" if !warnings::enabled("syntax") ;
1;
--FILE--
use warnings 'syntax' ;
require "abc3" ;
EXPECT
ok1
ok2
########

--FILE-- abc4
use warnings 'syntax' ;
print "ok1\n" if ! warnings::enabled('all') ;
print "ok2\n" if ! warnings::enabled("syntax") ;
print "ok3\n" if ! warnings::enabled("io") ;
1;
--FILE--
use warnings 'io' ;
require "abc4" ;
EXPECT
ok1
ok2
ok3
########

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

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

--FILE-- abc7
package abc7 ;
no warnings ;
sub check {
  print "ok1\n" if !warnings::enabled('all') ;
  print "ok2\n" if warnings::enabled("syntax") ;
}
1;
--FILE--
use warnings 'syntax' ;
require "abc7" ;
abc7::check() ;
EXPECT
ok1
ok2
########

--FILE-- abc8
package abc8 ;
use warnings 'io' ;
sub check {
  print "ok1\n" if ! warnings::enabled('all') ;
  print "ok2\n" if   warnings::enabled("syntax") ;
  print "ok3\n" if ! warnings::enabled("io") ;
}
1;
--FILE--
use warnings 'syntax' ;
require "abc8" ;
abc8::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc9.pm
package abc9 ;
use warnings "io" ;
print "ok1\n" if ! warnings::enabled('all') ;
print "ok2\n" if ! warnings::enabled("io") ;
1;
--FILE-- def.pm
package def;
no warnings;
use abc9 ;
1;
--FILE--
use warnings;
use def ;
EXPECT
ok1
ok2
########

--FILE-- abc10.pm
package abc10 ;
no warnings ;
print "ok1\n" if ! warnings::enabled('all') ;
print "ok2\n" if warnings::enabled("syntax") ;
print "ok3\n" if !warnings::enabled("io") ;
1;
--FILE-- def.pm
use warnings 'syntax' ;
print "ok4\n" if !warnings::enabled('all') ;
print "ok5\n" if !warnings::enabled("io") ;
use abc10 ;
1;
--FILE--
use warnings 'io' ;
use def ;
EXPECT
ok1
ok2
ok3
ok4
ok5
########

--FILE-- abc11.pm
package abc11 ;
no warnings ;
sub check {
  print "ok1\n" if !warnings::enabled('all') ;
  print "ok2\n" if warnings::enabled("syntax") ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc11 ;
eval {
  abc11::check() ;
};
print $@ ;
EXPECT
ok1
ok2
########

--FILE-- abc12.pm
package abc12 ;
use warnings 'io' ;
sub check {
  print "ok1\n" if ! warnings::enabled('all') ;
  print "ok2\n" if   warnings::enabled("syntax") ;
  print "ok3\n" if ! warnings::enabled("io") ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc12 ;
eval {
  abc12::check() ;
  } ;
print $@ ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc13
package abc13 ;
no warnings ;
sub check {
  print "ok1\n" if !warnings::enabled('all') ;
  print "ok2\n" if warnings::enabled("syntax") ;
}
1;
--FILE--
use warnings 'syntax' ;
require "abc13" ;
eval {
  abc13::check() ;
  } ;
print $@ ;
EXPECT
ok1
ok2
########

--FILE-- abc14
package abc14 ;
use warnings 'io' ;
sub check {
  print "ok1\n" if !warnings::enabled('all') ;
  print "ok2\n" if warnings::enabled("syntax") ;
  print "ok3\n" if warnings::enabled("io") ;
}
1;
--FILE--
use warnings 'syntax' ;
require "abc14" ;
eval {
  use warnings 'io' ;
  abc14::check() ;
};
abc14::check() ;
print $@ ;
EXPECT
ok1
ok2
ok3
ok1
ok2
########

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

--FILE-- abc16.pm
package abc16 ;
use warnings 'io' ;
sub check {
  print "ok1\n" if  ! warnings::enabled('all') ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc16 ;
sub fred { no warnings ; abc16::check() }
fred() ;
EXPECT
ok1
########

--FILE-- abc17.pm
package abc17 ;
use warnings 'misc' ;
sub check {
  print "ok1\n" if  ! warnings::enabled('all') ;
  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 abc17 ;
sub fred { use warnings 'io'  ; abc17::check() }
fred() ;
EXPECT
ok1
ok2
ok3
ok4
########

# check warnings::warn
use warnings ;
eval {
    warnings::warn()
  } ;
print $@ ;
eval {
  warnings::warn("fred", "joe")
  } ;
print $@ ;
EXPECT
Usage: warnings::warn([category,] 'message') at - line 5.
Unknown warnings category 'fred' at - line 9.
########

# check warnings::warnif
use warnings ;
eval {
  warnings::warnif()
} ;
print $@ ;
eval {
  warnings::warnif("fred", "joe")
} ;
print $@ ;
EXPECT
Usage: warnings::warnif([category,] 'message') at - line 5.
Unknown warnings category 'fred' at - line 9.
########

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

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

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

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

--FILE-- abc24.pm
package abc24 ;
no warnings ;
sub check {
  print "ok\n" if ! warnings::enabled() ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc24 ;
abc24::check() ;
EXPECT
package 'abc24' not registered for warnings at abc24.pm line 4.
########

--FILE-- abc25.pm
package abc25 ;
no warnings ;
sub check {
  warnings::warn("fred") ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc25 ;
abc25::check() ;
EXPECT
package 'abc25' not registered for warnings at abc25.pm line 4.
########

--FILE-- abc26.pm
package abc26 ;
no warnings ;
sub check {
  warnings::warnif("fred") ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc26 ;
abc26::check() ;
EXPECT
package 'abc26' not registered for warnings at abc26.pm line 4.
########

--FILE-- abc27.pm
package abc27 ;
use warnings 'io' ;
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") ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc27 ;
use warnings 'abc27' ;
abc27::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc28.pm
package abc28 ;
use warnings 'io' ;
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") ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc28 ;
abc28::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc29.pm
package abc29 ;
no warnings ;
use warnings::register ;
sub check {
  print "ok1\n" if warnings::enabled ;
  print "ok2\n" if warnings::enabled("syntax") ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc29 ;
use warnings 'abc29' ;
eval { abc29::check() ; };
print $@ ;
EXPECT
ok1
ok2
########

--FILE-- abc30.pm
package abc30 ;
use warnings 'io' ;
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") ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc30 ;
eval { abc30::check() ; } ;
print $@ ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc31.pm
package abc31 ;
use warnings 'io' ;
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") ;
}
1;
--FILE--
use warnings 'syntax' ;
use abc31 ;
use warnings 'abc31' ;
sub fred { abc31::check() }
fred() ;
EXPECT
ok1
ok2
ok3
########

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

--FILE-- abc33.pm
package abc33 ;
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 abc33 ;
use warnings 'abc33' ;
sub fred { use warnings 'io'  ; abc33::check() }
fred() ;
EXPECT
ok1
ok2
ok3
ok4
########

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

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

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

--FILE-- abc37.pm
package abc37 ;
use warnings::register ;
sub check { warnings::warn("hello") }
1;
--FILE--
use abc37;
use warnings qw( FATAL abc37 ) ;
eval {
  abc37::check() ;
  } ;
print "[[$@]]\n";
EXPECT
[[hello at - line 4.
]]
########
-W
--FILE-- abc38.pm
package abc38 ;
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 abc38 ;
abc38::check() ;
EXPECT
ok1
ok2
ok3
########
-X
--FILE-- abc39.pm
package abc39 ;
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 abc39 ;
abc39::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc40.pm
package abc40 ;
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 abc40 ;
abc40::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc41.pm
package abc41 ;
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 abc41 ;
no warnings ;
abc41::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc42.pm
package abc42 ;
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('abc42', "my message 2") ;
  warnings::warnif('io', "my message 3") ;
  warnings::warnif('all', "my message 4") ;
}
1;
--FILE--
use abc42 ;
use warnings 'abc42';
no warnings ;
abc42::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc43.pm
package abc43 ;
use warnings "io" ;
use warnings::register ;
sub check {
  print "abc43 self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
  print "abc43 def"  . (warnings::enabled('def') ? "" : " not") . " enabled\n" ;
  print "abc43 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 abc43"  . (warnings::enabled('abc43') ? "" : " not") . " enabled\n" ;
  print "def all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
}
1;
--FILE--
use abc43 ;
use def ;
use warnings 'abc43';
abc43::check() ;
def::check() ;
no warnings 'abc43'  ;
use warnings 'def'  ;
abc43::check() ;
def::check() ;
use warnings 'abc43'  ;
use warnings 'def'  ;
abc43::check() ;
def::check() ;
no warnings 'abc43'  ;
no warnings 'def'  ;
abc43::check() ;
def::check() ;
use warnings;
abc43::check() ;
def::check() ;
no warnings 'abc43' ;
abc43::check() ;
def::check() ;
EXPECT
abc43 self enabled
abc43 def not enabled
abc43 all not enabled
def self not enabled
def abc43 enabled
def all not enabled
abc43 self not enabled
abc43 def enabled
abc43 all not enabled
def self enabled
def abc43 not enabled
def all not enabled
abc43 self enabled
abc43 def enabled
abc43 all not enabled
def self enabled
def abc43 enabled
def all not enabled
abc43 self not enabled
abc43 def not enabled
abc43 all not enabled
def self not enabled
def abc43 not enabled
def all not enabled
abc43 self enabled
abc43 def enabled
abc43 all enabled
def self enabled
def abc43 enabled
def all enabled
abc43 self not enabled
abc43 def enabled
abc43 all enabled
def self enabled
def abc43 not enabled
def all enabled
########
-w
--FILE-- abc44.pm
package abc44 ;
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 abc44 ;
abc44::check() ;
EXPECT
ok1
ok2
ok3
########
-w
--FILE-- abc45.pm
package abc45 ;
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 abc45 ;
use warnings 'abc45';
no warnings ;
abc45::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc46.pm
package abc46 ;
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('abc46', "my message 2") ;
  warnings::warnif('io', "my message 3") ;
  warnings::warnif('all', "my message 4") ;
}
1;
--FILE--
use abc46 ;
use warnings 'abc46';
no warnings ;
BEGIN { $^W = 1 ; }
abc46::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc47.pm
package abc47 ;
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 abc47 ;
use warnings 'abc47';
no warnings ;
$^W = 1 ;
abc47::check() ;
EXPECT
ok1
ok2
ok3
########

--FILE-- abc48.pm
$| = 1;
package abc48 ;
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("abc48") ;
  warnings::warn("my message 1") ;
  warnings::warnif("my message 2") ;
  warnings::warnif('abc48', "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 abc48 ;
use warnings 'abc48';
abc48::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-- abc49.pm
$| = 1;
package abc49 ;
use def ;
use warnings 'def';
sub in1 { def::in1() ; }
1;
--FILE--
use abc49 ;
no warnings;
abc49::in1() ;
EXPECT
ok1
ok2
ok3
ok4
my message 1 at abc49.pm line 5.
my message 2 at abc49.pm line 5.
my message 3 at abc49.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("abc50") ;
  print "ok5\n" if !warnings::enabled("def") ;
  warnings::warn("my message 1") ;
  warnings::warnif("my message 2") ;
  warnings::warnif('abc50', "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-- abc50.pm
package abc50 ;
use warnings::register ;
use def ;
#@ISA = qw(def) ;
1;
--FILE--
use abc50 ;
no warnings;
use warnings 'abc50';
abc50::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("abc51") ;
  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('abc51', "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-- abc51.pm
$| = 1;
package abc51 ;
use warnings::register ;
use def ;
@ISA = qw(def) ;
sub new
{
    my $class = shift ;
    bless [], $class ;
}

1;
--FILE--
use abc51 ;
no warnings;
use warnings 'abc51';
$a = new abc51 ;
$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-- abc52.pm
package abc52 ;
use warnings::register ('foo', 'bar');
sub check {
    warnings::warnif('abc52', "hello");
    warnings::warnif('abc52::foo', "hello foo");
    warnings::warnif('abc52::bar', "hello bar");
}
1;
--FILE--
use abc52;
use warnings("abc52", "abc52::bar");
abc52::check() ;
EXPECT
hello at - line 3.
hello bar at - line 3.
########

--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
########

--FILE-- fatal1.pm
package fatal1 ;
no warnings ;
print "ok1\n" if !warnings::fatal_enabled('all') ;
print "ok2\n" if !warnings::fatal_enabled("syntax") ;
1;
--FILE--
use fatal1 ;
EXPECT
ok1
ok2
########

--FILE-- fatal2.pm
package  fatal2;
no warnings ;
print "ok1\n" if !warnings::fatal_enabled('all') ;
print "ok2\n" if warnings::fatal_enabled("syntax") ;
1;
--FILE--
use warnings FATAL => 'syntax' ;
use fatal2 ;
EXPECT
ok1
ok2
########

--FILE-- fatal3.pm
package fatal3 ;
no warnings ;
print "ok1\n" if warnings::fatal_enabled('all') ;
print "ok2\n" if warnings::fatal_enabled("syntax") ;
1;
--FILE--
use warnings FATAL => 'all' ;
use fatal3 ;
EXPECT
ok1
ok2
########

--FILE-- fatal4.pm
package fatal4 ;
no warnings ;
print "ok1\n" if warnings::fatal_enabled('all') ;
print "ok2\n" if warnings::fatal_enabled("void") ;
print "ok3\n" if !warnings::fatal_enabled("syntax") ;
1;
--FILE--
use warnings FATAL => 'all', NONFATAL => 'syntax' ;
use fatal4 ;
EXPECT
ok1
ok2
ok3
########
{ Quux::quux(); }
{ no warnings; Quux::quux(); }
{ no warnings; use warnings "void"; Quux::quux(); }
{ use warnings; Quux::quux(); }
{ use warnings; no warnings "void"; Quux::quux(); }
use warnings ();
BEGIN { warnings::register_categories(qw(wibble wobble wabble wubble webble)); }
package Quux {
  sub quux {
    warnings::warnif($_, "My $_ is flanged")
      foreach qw(wibble wobble wabble wubble webble);
    ();
  }
}
{ Quux::quux(); }
{ no warnings; Quux::quux(); }
{ no warnings; use warnings "void"; Quux::quux(); }
{ use warnings; Quux::quux(); }
{ use warnings; no warnings "void"; Quux::quux(); }
{ no warnings; use warnings qw(wibble wabble webble); Quux::quux(); }
{ no warnings; use warnings qw(wobble wubble); Quux::quux(); }
{ use warnings; no warnings qw(wibble wabble webble); Quux::quux(); }
{ use warnings; no warnings qw(wobble wubble); Quux::quux(); }
{ use warnings qw(wubble NONFATAL void); Quux::quux(); }
{ use warnings qw(wubble); no warnings "void"; Quux::quux(); }
{ no warnings "webble"; Quux::quux(); }
{ use warnings qw(NONFATAL webble); Quux::quux(); }
print "done\n";
EXPECT
My wibble is flanged at - line 4.
My wobble is flanged at - line 4.
My wabble is flanged at - line 4.
My wubble is flanged at - line 4.
My webble is flanged at - line 4.
My wibble is flanged at - line 5.
My wobble is flanged at - line 5.
My wabble is flanged at - line 5.
My wubble is flanged at - line 5.
My webble is flanged at - line 5.
My wibble is flanged at - line 18.
My wobble is flanged at - line 18.
My wabble is flanged at - line 18.
My wubble is flanged at - line 18.
My webble is flanged at - line 18.
My wibble is flanged at - line 19.
My wobble is flanged at - line 19.
My wabble is flanged at - line 19.
My wubble is flanged at - line 19.
My webble is flanged at - line 19.
My wibble is flanged at - line 20.
My wabble is flanged at - line 20.
My webble is flanged at - line 20.
My wobble is flanged at - line 21.
My wubble is flanged at - line 21.
My wobble is flanged at - line 22.
My wubble is flanged at - line 22.
My wibble is flanged at - line 23.
My wabble is flanged at - line 23.
My webble is flanged at - line 23.
My wubble is flanged at - line 24.
My wubble is flanged at - line 25.
My webble is flanged at - line 27.
done
########
# NAME _at_level
select STDERR;
{ use warnings "utf8"; foo() }
sub foo { use warnings "syntax"; bar() }
sub bar {
 use warnings "unpack";
 local $\="\n";
 print "1. ", warnings::enabled_at_level("unpack", 0)||0;
 print "2. ", warnings::enabled_at_level("unpack", 1)||0;
 print "3. ", warnings::enabled_at_level("unpack", 2)||0;
 print "4. ", warnings::enabled_at_level("syntax", 0)||0;
 print "5. ", warnings::enabled_at_level("syntax", 1)||0;
 print "6. ", warnings::enabled_at_level("syntax", 2)||0;
 print "7. ", warnings::enabled_at_level("utf8", 0)||0;
 print "8. ", warnings::enabled_at_level("utf8", 1)||0;
 print "9. ", warnings::enabled_at_level("utf8", 2)||0;
 warnings::warn_at_level  ("misc",0,"A mandatory foo warning");
 warnings::warn_at_level  ("misc",1,"A mandatory top-level warning");
 warnings::warnif_at_level("syntax",0,"A conditional syntax warning");
 warnings::warnif_at_level("syntax",1,"A conditional syntax warning");
 warnings::warnif_at_level("utf8",0,"A conditional utf8 warning");
 warnings::warnif_at_level("utf8",1,"A conditional utf8 warning");
}
{ use warnings "syntax"; use warnings FATAL => "utf8"; foo2() }
sub foo2 {
  use warnings FATAL => "syntax"; use warnings "utf8"; bar2()
}
sub bar2 {
 $\="\n";
 print "10. ", warnings::fatal_enabled_at_level("syntax", 0)||0;
 print "11. ", warnings::fatal_enabled_at_level("syntax", 1)||0;
 print "12. ", warnings::fatal_enabled_at_level("utf8", 0)||0;
 print "13. ", warnings::fatal_enabled_at_level("utf8", 1)||0;
 undef $\;
 eval { warnings::warn_at_level  ("syntax",1,"A fatal warning") };
 print "Died: $@" if $@;
 eval { warnings::warnif_at_level("syntax",1,"A fatal syntax warning") };
 print "Died: $@" if $@;
 eval { warnings::warnif_at_level("syntax",2,"A syntax warning") };
 print "Died: $@" if $@;
 eval { warnings::warnif_at_level("utf8",1,"A utf8 warning") };
 print "Died: $@" if $@;
 eval { warnings::warnif_at_level("utf8",2,"A fatal utf8 warning") };
 print "Died: $@" if $@;
}
EXPECT
1. 0
2. 0
3. 0
4. 1
5. 0
6. 0
7. 0
8. 1
9. 0
A mandatory foo warning at - line 3.
A mandatory top-level warning at - line 2.
A conditional syntax warning at - line 3.
A conditional utf8 warning at - line 2.
10. 1
11. 0
12. 0
13. 1
Died: A fatal warning at - line 25.
Died: A fatal syntax warning at - line 25.
A syntax warning at - line 23.
A utf8 warning at - line 25.
Died: A fatal utf8 warning at - line 23.
########
# NAME _at_level with filehandle
use warnings;
# Create temp file for testing handles.
open oUt, ">tmp" or die $!;
print oUt "foo\nbar\n";
close oUt;
sub bimp {
 open FH, "tmp";
 <FH>; <FH>;
 warnings::warn_at_level("syntax", 0, "Foo warning");
 close FH;
 warnings::warn_at_level("syntax", 0, "Bar warning");
};
bimp;
EXPECT
Foo warning at - line 13, <FH> line 2.
Bar warning at - line 13.
########
# NAME _at_level with chunky filehandle
use warnings;
# Create temp file for testing handles.
open oUt, ">tmp" or die $!;
print oUt "foo7bar7";
close oUt;
sub bimp {
 open FH, "tmp";
 $/ = 7;
 <FH>; <FH>;
 warnings::warn_at_level("syntax", 0, "Foo warning");
 close FH;
 warnings::warn_at_level("syntax", 0, "Bar warning");
};
bimp;
EXPECT
Foo warning at - line 14, <FH> chunk 2.
Bar warning at - line 14.