Check warnings::enabled & warnings::warn __END__ --FILE-- abc.pm package abc ; use warnings "io" ; print "ok1\n" if ! warnings::enabled('all') ; print "ok2\n" if ! warnings::enabled("io") ; 1; --FILE-- no warnings; use abc ; EXPECT ok1 ok2 ######## --FILE-- abc.pm package abc ; no warnings ; print "ok1\n" if !warnings::enabled('all') ; print "ok2\n" if warnings::enabled("syntax") ; 1; --FILE-- use warnings 'syntax' ; use abc ; EXPECT ok1 ok2 ######## --FILE-- abc.pm package abc ; use warnings 'syntax' ; print "ok1\n" if warnings::enabled('io') ; print "ok2\n" if ! warnings::enabled("syntax") ; 1; --FILE-- use warnings 'io' ; use abc ; EXPECT ok1 ok2 ######## --FILE-- abc no warnings ; print "ok1\n" if !warnings::enabled('all') ; print "ok2\n" if !warnings::enabled("syntax") ; 1; --FILE-- use warnings 'syntax' ; require "abc" ; EXPECT ok1 ok2 ######## --FILE-- abc 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 "abc" ; EXPECT ok1 ok2 ok3 ######## --FILE-- abc.pm package abc ; no warnings ; sub check { print "ok1\n" if !warnings::enabled('all') ; print "ok2\n" if warnings::enabled("syntax") ; } 1; --FILE-- use warnings 'syntax' ; use abc ; abc::check() ; EXPECT ok1 ok2 ######## --FILE-- abc.pm package abc ; 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 abc ; abc::check() ; EXPECT ok1 ok2 ok3 ######## --FILE-- abc package abc ; no warnings ; sub check { print "ok1\n" if !warnings::enabled('all') ; print "ok2\n" if warnings::enabled("syntax") ; } 1; --FILE-- use warnings 'syntax' ; require "abc" ; abc::check() ; EXPECT ok1 ok2 ######## --FILE-- abc package abc ; 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 "abc" ; abc::check() ; EXPECT ok1 ok2 ok3 ######## --FILE-- abc.pm package abc ; 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 abc ; 1; --FILE-- use warnings; use def ; EXPECT ok1 ok2 ######## --FILE-- abc.pm package abc ; 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 abc ; 1; --FILE-- use warnings 'io' ; use def ; EXPECT ok1 ok2 ok3 ok4 ok5 ######## --FILE-- abc.pm package abc ; no warnings ; sub check { print "ok1\n" if !warnings::enabled('all') ; print "ok2\n" if warnings::enabled("syntax") ; } 1; --FILE-- use warnings 'syntax' ; use abc ; eval { abc::check() ; }; print $@ ; EXPECT ok1 ok2 ######## --FILE-- abc.pm package abc ; 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 abc ; eval { abc::check() ; } ; print $@ ; EXPECT ok1 ok2 ok3 ######## --FILE-- abc package abc ; no warnings ; sub check { print "ok1\n" if !warnings::enabled('all') ; print "ok2\n" if warnings::enabled("syntax") ; } 1; --FILE-- use warnings 'syntax' ; require "abc" ; eval { abc::check() ; } ; print $@ ; EXPECT ok1 ok2 ######## --FILE-- abc package abc ; 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 "abc" ; eval { use warnings 'io' ; abc::check() ; }; abc::check() ; print $@ ; EXPECT ok1 ok2 ok3 ok1 ok2 ######## --FILE-- abc.pm package abc ; 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 abc ; sub fred { abc::check() } fred() ; EXPECT ok1 ok2 ok3 ######## --FILE-- abc.pm package abc ; use warnings 'io' ; sub check { print "ok1\n" if ! warnings::enabled('all') ; } 1; --FILE-- use warnings 'syntax' ; use abc ; sub fred { no warnings ; abc::check() } fred() ; EXPECT ok1 ######## --FILE-- abc.pm package abc ; 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 abc ; sub fred { use warnings 'io' ; abc::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-- abc.pm package abc ; use warnings 'misc' ; sub check { warnings::warn("io", "hello") } 1; --FILE-- use warnings "io" ; use abc; abc::check() ; EXPECT hello at - line 3 ######## --FILE-- abc.pm package abc ; use warnings 'misc' ; sub check { warnings::warn("misc", "hello") } 1; --FILE-- use warnings "io" ; use abc; abc::check() ; EXPECT hello at - line 3 ######## --FILE-- abc.pm package abc ; use warnings 'misc' ; sub check { warnings::warn("io", "hello") } 1; --FILE-- use warnings qw( FATAL deprecated ) ; use abc; eval { abc::check() ; } ; print "[[$@]]\n"; EXPECT hello at - line 4 [[]] ######## --FILE-- abc.pm package abc ; use warnings 'misc' ; sub check { warnings::warn("io", "hello") } 1; --FILE-- use warnings qw( FATAL io ) ; use abc; eval { abc::check() ; } ; print "[[$@]]\n"; EXPECT [[hello at - line 4 ]] ######## -W --FILE-- abc.pm package abc ; use warnings "io" ; print "ok1\n" if warnings::enabled("io") ; print "ok2\n" if warnings::enabled("all") ; 1; --FILE-- no warnings; use abc ; EXPECT ok1 ok2 ######## -X --FILE-- abc.pm package abc ; use warnings "io" ; print "ok1\n" if !warnings::enabled("io") ; print "ok2\n" if !warnings::enabled("all") ; 1; --FILE-- use warnings; use abc ; EXPECT ok1 ok2 ######## --FILE-- abc.pm package abc ; no warnings ; sub check { print "ok\n" if ! warnings::enabled() ; } 1; --FILE-- use warnings 'syntax' ; use abc ; abc::check() ; EXPECT package 'abc' not registered for warnings at abc.pm line 4 ######## --FILE-- abc.pm package abc ; no warnings ; sub check { warnings::warn("fred") ; } 1; --FILE-- use warnings 'syntax' ; use abc ; abc::check() ; EXPECT package 'abc' not registered for warnings at abc.pm line 4 ######## --FILE-- abc.pm package abc ; no warnings ; sub check { warnings::warnif("fred") ; } 1; --FILE-- use warnings 'syntax' ; use abc ; abc::check() ; EXPECT package 'abc' not registered for warnings at abc.pm line 4 ######## --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("syntax") ; print "ok3\n" if !warnings::enabled("io") ; } 1; --FILE-- use warnings 'syntax' ; use abc ; use warnings '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("syntax") ; print "ok3\n" if !warnings::enabled("io") ; } 1; --FILE-- use warnings 'syntax' ; use abc ; 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("syntax") ; } 1; --FILE-- use warnings 'syntax' ; use abc ; use warnings 'abc' ; eval { abc::check() ; }; print $@ ; EXPECT ok1 ok2 ######## --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("syntax") ; print "ok3\n" if !warnings::enabled("io") ; } 1; --FILE-- use warnings 'syntax' ; use abc ; eval { abc::check() ; } ; print $@ ; 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("syntax") ; print "ok3\n" if !warnings::enabled("io") ; } 1; --FILE-- use warnings 'syntax' ; use abc ; use warnings 'abc' ; sub fred { abc::check() } fred() ; EXPECT ok1 ok2 ok3 ######## --FILE-- abc.pm package abc ; use warnings 'io' ; use warnings::register ; sub check { print "ok1\n" if ! warnings::enabled ; } 1; --FILE-- use warnings 'syntax' ; use abc ; sub fred { no warnings ; abc::check() } fred() ; 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