$DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
$DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
if ($1 eq 'globally') {
- local $^W;
+ no warnings;
*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
}
next;
use 5.005_64;
use strict;
no strict 'refs';
+use warnings::register;
our(%attr, $VERSION);
$VERSION = "1.01";
if ($fno and $fno != $next) {
require Carp;
if ($fno < $fattr->[0]) {
- Carp::carp("Hides field '$f' in base class") if $^W;
+ warnings::warn("Hides field '$f' in base class")
+ if warnings::enabled();
} else {
Carp::croak("Field name '$f' already in use");
}
=head1 DIAGNOSTICS
-The B<-w> switch produces some lovely diagnostics.
+The C<use warnings> pragma (and the B<-w> switch) produces some
+lovely diagnostics.
See L<perldiag> for explanations of all Perl's diagnostics. The C<use
diagnostics> pragma automatically turns Perl's normally terse warnings
context. Assignment to a list (or slice, which is just a list
anyway) also evaluates the righthand side in list context.
-When you use Perl's B<-w> command-line option, you may see warnings
+When you use the C<use warnings> pragma or Perl's B<-w> command-line
+option, you may see warnings
about useless uses of constants or functions in "void context".
Void context just means the value has been discarded, such as a
statement containing only C<"fred";> or C<getpwuid(0);>. It still
be treated as if it were a quoted string. These are known as
"barewords". As with filehandles and labels, a bareword that consists
entirely of lowercase letters risks conflict with future reserved
-words, and if you use the B<-w> switch, Perl will warn you about any
+words, and if you use the C<use warnings> pragma or the B<-w> switch,
+Perl will warn you about any
such words. Some people may wish to outlaw barewords entirely. If you
say
fix very easily.
use strict ;
+ use warnings ;
use SDBM_File ;
use Fcntl ;
# Install DBM Filters
$db->filter_fetch_key ( sub { s/\0$// } ) ;
$db->filter_store_key ( sub { $_ .= "\0" } ) ;
- $db->filter_fetch_value( sub { s/\0$// } ) ;
+ $db->filter_fetch_value(
+ sub { no warnings 'uninitialized' ;s/\0$// } ) ;
$db->filter_store_value( sub { $_ .= "\0" } ) ;
$hash{"abc"} = "def" ;
Here is a DBM Filter that does it:
use strict ;
+ use warnings ;
use DB_File ;
my %hash ;
my $filename = "/tmp/filt" ;
=head2 How do I debug my Perl programs?
-Have you used C<-w>? It enables warnings for dubious practices.
+Have you tried C<use warnings> or used C<-w>? They enable warnings
+for dubious practices.
Have you tried C<use strict>? It prevents you from using symbolic
references, makes you predeclare any subroutines that you call as bare
@bad[0] = `same program that outputs several lines`;
-The B<-w> flag will warn you about these matters.
+The C<use warnings> pragma and the B<-w> flag will warn you about these
+matters.
=head2 How can I remove duplicate elements from a list or array?
sub compare_arrays {
my ($first, $second) = @_;
- local $^W = 0; # silence spurious -w undef complaints
+ no warnings; # silence spurious -w undef complaints
return 0 unless @$first == @$second;
for (my $i = 0; $i < @$first; $i++) {
return 0 if $first->[$i] ne $second->[$i];
=head2 How do I temporarily block warnings?
-The C<$^W> variable (documented in L<perlvar>) controls
-runtime warnings for a block:
+If you are running Perl 5.6.0 or better, the C<use warnings> pragma
+allows fine control of what warning are produced.
+See L<perllexwarn> for more details.
+
+ {
+ no warnings; # temporarily turn off warnings
+ $a = $b + $c; # I know these might be undef
+ }
+
+If you have an older version of Perl, the C<$^W> variable (documented
+in L<perlvar>) controls runtime warnings for a block:
{
local $^W = 0; # temporarily turn off warnings
Note that like all the punctuation variables, you cannot currently
use my() on C<$^W>, only local().
-A new C<use warnings> pragma is in the works to provide finer control
-over all this. The curious should check the perl5-porters mailing list
-archives for details.
-
=head2 What's an extension?
A way of calling compiled C code from Perl. Reading L<perlxstut>
package Some::Module; # assumes Some/Module.pm
use strict;
+ use warnings;
BEGIN {
use Exporter ();
package Debug;
use strict;
+ use warnings;
use Filter::Util::Call ;
use constant TRUE => 1 ;
open(PROG_FOR_READING_AND_WRITING, "| some program |")
-and if you forget to use the B<-w> flag, then you'll miss out
-entirely on the diagnostic message:
+and if you forget to use the C<use warnings> pragma or the B<-w> flag,
+then you'll miss out entirely on the diagnostic message:
Can't do bidirectional pipe at -e line 1.
package Some::Module; # assumes Some/Module.pm
use strict;
+ use warnings;
BEGIN {
use Exporter ();
=item Try to design the new module to be easy to extend and reuse.
-Always use B<-w>.
+Try to C<use warnings;> (or C<use warnings qw(...);>).
+Remember that you can add C<no warnings qw(...);> to individual blocks
+of code that need less warnings.
Use blessed references. Use the two argument form of bless to bless
into the class name given as the first parameter of the constructor,
A common mistake is to try to separate the words with comma or to
put comments into a multi-line C<qw>-string. For this reason, the
-B<-w> switch (that is, the C<$^W> variable) produces warnings if
-the STRING contains the "," or the "#" character.
+C<use warnings> pragma and the B<-w> switch (that is, the C<$^W> variable)
+produces warnings if the STRING contains the "," or the "#" character.
=item s/PATTERN/REPLACEMENT/egimosx
It is at this step that C<\1> is begrudgingly converted to C<$1> in
the replacement text of C<s///> to correct the incorrigible
I<sed> hackers who haven't picked up the saner idiom yet. A warning
-is emitted if the B<-w> command-line flag (that is, the C<$^W> variable)
-was set.
+is emitted if the C<use warnings> pragma or the B<-w> command-line flag
+(that is, the C<$^W> variable) was set.
The lack of processing of C<\\> creates specific restrictions on
the post-processed text. If the delimiter is C</>, one cannot get
while (<STDIN>) { last unless $_; ... }
In other boolean contexts, C<< <I<filehandle>> >> without an
-explicit C<defined> test or comparison elicit a warning if the B<-w>
+explicit C<defined> test or comparison elicit a warning if the
+C<use warnings> pragma or the B<-w>
command-line switch (the C<$^W> variable) is in effect.
The filehandles STDIN, STDOUT, and STDERR are predefined. (The
this yourself would be a productive exercise), but finishes in a fourth
the time when used on a similar string with 1000000 C<a>s. Be aware,
however, that this pattern currently triggers a warning message under
-B<-w> saying it C<"matches the null string many times">):
+the C<use warnings> pragma or B<-w> switch saying it
+C<"matches the null string many times">):
On simple groups, such as the pattern C<< (?> [^()]+ ) >>, a comparable
effect may be achieved by negative look-ahead, as in C<[^()]+ (?! [^()] )>.
$array{ +shift }
$array{ shift @_ }
-The B<-w> switch will warn you if it interprets a reserved word as a string.
+The C<use warnings> pragma or the B<-w> switch will warn you if it
+interprets a reserved word as a string.
But it will no longer warn you about using lowercase words, because the
string is effectively quoted.
C<__WARN__> hooks, as described in L<perlvar> and L<perlfunc/warn>.
See also L<perldiag> and L<perltrap>. A new, fine-grained warning
facility is also available if you want to manipulate entire classes
-of warnings; see L<warnings> (or better yet, its source code) about
-that.
+of warnings; see L<warnings> or L<perllexwarn>.
=item B<-W>
The most important thing is to run your programs under the B<-w>
flag at all times. You may turn it off explicitly for particular
-portions of code via the C<$^W> variable if you must. You should
+portions of code via the C<use warnings> pragma or the C<$^W> variable
+if you must. You should
also always run under C<use strict> or know the reason why not.
The C<use sigtrap> and even C<use diagnostics> pragmas may also prove
useful.
Think about reusability. Why waste brainpower on a one-shot when you
might want to do something like it again? Consider generalizing your
code. Consider writing a module or object class. Consider making your
-code run cleanly with C<use strict> and B<-w> in effect. Consider giving away
+code run cleanly with C<use strict> and C<use warnings> (or B<-w>) in effect
+Consider giving away
your code. Consider changing your whole world view. Consider... oh,
never mind.
If the LABEL is omitted, the loop control statement
refers to the innermost enclosing loop. This may include dynamically
looking back your call-stack at run time to find the LABEL. Such
-desperate behavior triggers a warning if you use the B<-w> flag.
+desperate behavior triggers a warning if you use the C<use warnings>
+praga or the B<-w> flag.
Unlike a C<foreach> statement, a C<while> statement never implicitly
localises any variables.
package Remember;
use strict;
+ use warnings;
use IO::File;
sub TIESCALAR {
Now that you know what the problem is, what can you do to avoid it?
Well, the good old C<-w> flag will spot any instances where you call
untie() and there are still valid references to the tied object. If
-the second script above is run with the C<-w> flag, Perl prints this
+the second script above this near the top C<use warnings 'untie'>
+or was run with the C<-w> flag, Perl prints this
warning message:
untie attempted while 1 inner references still exist
If you find an example of a conversion trap that is not listed here,
please submit it to Bill Middleton <F<wjm@best.com>> for inclusion.
-Also note that at least some of these can be caught with B<-w>.
+Also note that at least some of these can be caught with the
+C<use warnings> pragma or the B<-w> switch.
=head2 Discontinuance, Deprecation, and BugFix traps
(128..255) should be written C<\x{ab}> rather than C<\xab>, since the
former will turn into a two-byte UTF-8 code, while the latter will
continue to be interpreted as generating a 8-bit byte rather than a
-character. In fact, if C<-w> is turned on, it will produce a warning
+character. In fact, if the C<use warnings> pragma of the C<-w> switch
+is turned on, it will produce a warning
that you might be generating invalid UTF-8.
=item *
package Mytest;
use strict;
+ use warnings;
require Exporter;
require DynaLoader;
#!./perl
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+}
+
# $RCSfile$
$| = 1;
-$^W = 1;
+use warnings;
$Is_VMS = $^O eq 'VMS';
print "1..66\n";
}
use strict;
+use warnings;
use vars qw($DEBUG);
package B1;
unshift @INC, '../lib';
}
+use warnings;
use Text::ParseWords;
print "1..18\n";
print "not " if $words[2] ne 'zoo';
print "ok 3\n";
-# Gonna get some undefined things back
-local($^W) = 0;
+{
+ # Gonna get some undefined things back
+ no warnings 'uninitialized' ;
-# Test quotewords() with other parameters and null last field
-@words = quotewords(':+', 1, 'foo:::"bar:foo":zoo zoo:');
-print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo;);
-print "ok 4\n";
-
-$^W = 1;
+ # Test quotewords() with other parameters and null last field
+ @words = quotewords(':+', 1, 'foo:::"bar:foo":zoo zoo:');
+ print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo;);
+ print "ok 4\n";
+}
# Test $keep eq 'delimiters' and last field zero
@words = quotewords('\s+', 'delimiters', '4 3 2 1 0');
print "not " if (@words);
print "ok 12\n";
-# Gonna get some more undefined things back
-$^W = 0;
+{
+ # Gonna get some more undefined things back
+ no warnings 'uninitialized' ;
-@words = nested_quotewords('s+', 0, $string);
-print "not " if (@words);
-print "ok 13\n";
+ @words = nested_quotewords('s+', 0, $string);
+ print "not " if (@words);
+ print "ok 13\n";
-# Now test empty fields
-$result = join('|', parse_line(':', 0, 'foo::0:"":::'));
-print "not " unless ($result eq 'foo||0||||');
-print "ok 14\n";
+ # Now test empty fields
+ $result = join('|', parse_line(':', 0, 'foo::0:"":::'));
+ print "not " unless ($result eq 'foo||0||||');
+ print "ok 14\n";
-# Test for 0 in quotes without $keep
-$result = join('|', parse_line(':', 0, ':"0":'));
-print "not " unless ($result eq '|0|');
-print "ok 15\n";
+ # Test for 0 in quotes without $keep
+ $result = join('|', parse_line(':', 0, ':"0":'));
+ print "not " unless ($result eq '|0|');
+ print "ok 15\n";
-# Test for \001 in quoted string
-$result = join('|', parse_line(':', 0, ':"' . "\001" . '":'));
-print "not " unless ($result eq "|\1|");
-print "ok 16\n";
+ # Test for \001 in quoted string
+ $result = join('|', parse_line(':', 0, ':"' . "\001" . '":'));
+ print "not " unless ($result eq "|\1|");
+ print "ok 16\n";
-$^W = 1;
+}
# Now test perlish single quote behavior
$Text::ParseWords::PERL_SINGLE_QUOTE = 1;
}
use strict;
+use warnings;
-$^W = 1;
my $warn = "";
$SIG{q(__WARN__)} = sub { print $warn; $warn .= join("",@_) };
# various typeglob tests
#
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+}
+
+use warnings;
+
print "1..30\n";
# type coersion on assignment
# fact that %X::Y:: is stored in %X:: isn't documented.
# (I hope.)
-{ package Foo::Bar; $test=1; }
+{ package Foo::Bar; no warnings 'once'; $test=1; }
print exists $Foo::{'Bar::'} ? "ok 12\n" : "not ok 12\n";
print $Foo::{'Bar::'} eq '*Foo::Bar::' ? "ok 13\n" : "not ok 13\n";
{
my $msg;
local $SIG{__WARN__} = sub { $msg = $_[0] };
- local $^W = 1;
+ use warnings;
*foo = 'bar';
print $msg ? "not ok" : "ok", " 15\n";
*foo = undef;
}
use strict;
+use warnings;
use vars qw{ @warnings };
BEGIN {
- $^W |= 1; # Insist upon warnings
- # ...and save 'em as we go
$SIG{'__WARN__'} = sub { push @warnings, @_ };
$| = 1;
print "1..9\n";
#!./perl
BEGIN {
- $^W = 1;
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib';
$SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
}
+use warnings;
+
sub ok {
my ($n, $result, $info) = @_;
if ($result) {
# temps
sub foo { my $a = "a"; return $a . $a++ . $a++ }
{
- local $^W = 1;
+ use warnings;
my $last = $test;
local $SIG{__WARN__} = sub {
print "ok ",$test++,"\n" if $_[0] =~ /temporary val/
sub must_warn {
my ($warn_pat, $code) = @_;
- local $^W; local %SIG;
- eval 'BEGIN { $^W = 1; $SIG{__WARN__} = $warn_pat };' . $code;
+ local %SIG;
+ eval 'BEGIN { use warnings; $SIG{__WARN__} = $warn_pat };' . $code;
print "ok $test\n";
$test++;
}
chdir 't' if -d 't';
unshift @INC, '../lib';
}
+use warnings;
print "1..49\n";
# XXX known to leak scalars
-$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+{
+ no warnings 'uninitialized';
+ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+}
-sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
-sub backwards_stacked($$) { my($a,$b) = @_; $a lt $b ? 1 : $a gt $b ? -1 : 0 }
+sub Backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
+sub Backwards_stacked($$) { my($a,$b) = @_; $a lt $b ? 1 : $a gt $b ? -1 : 0 }
my $upperfirst = 'A' lt 'a';
print "# 1: x = '$x', expected = '$expected'\n";
print ($x eq $expected ? "ok 1\n" : "not ok 1\n");
-$x = join('', sort( backwards @harry));
+$x = join('', sort( Backwards @harry));
$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
print "# 2: x = '$x', expected = '$expected'\n";
print ($x eq $expected ? "ok 2\n" : "not ok 2\n");
-$x = join('', sort( backwards_stacked @harry));
+$x = join('', sort( Backwards_stacked @harry));
$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
print "# 3: x = '$x', expected = '$expected'\n";
print ($x eq $expected ? "ok 3\n" : "not ok 3\n");
@b = sort {$a <=> $b;} @a;
print ("@b" eq "2 3 4 10" ? "ok 10\n" : "not ok 10 (@b)\n");
-$sub = 'backwards';
+$sub = 'Backwards';
$x = join('', sort $sub @harry);
$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
print "# 11: x = $x, expected = '$expected'\n";
print ($x eq $expected ? "ok 11\n" : "not ok 11\n");
-$sub = 'backwards_stacked';
+$sub = 'Backwards_stacked';
$x = join('', sort $sub @harry);
$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
print "# 12: x = $x, expected = '$expected'\n";
print ("@b" eq '1 2 3 4' ? "ok 16\n" : "not ok 16\n");
print "# x = '@b'\n";
-$^W = 0;
# redefining sort sub inside the sort sub should fail
sub twoface { *twoface = sub { $a <=> $b }; &twoface }
eval { @b = sort twoface 4,1,3,2 };
print ($@ =~ /redefine active sort/ ? "ok 17\n" : "not ok 17\n");
# redefining sort subs outside the sort should not fail
-eval { *twoface = sub { &backwards } };
+eval { no warnings 'redefine'; *twoface = sub { &Backwards } };
print $@ ? "not ok 18\n" : "ok 18\n";
eval { @b = sort twoface 4,1,3,2 };
print ("@b" eq '4 3 2 1' ? "ok 19\n" : "not ok 19 |@b|\n");
-*twoface = sub { *twoface = *backwards; $a <=> $b };
+{
+ no warnings 'redefine';
+ *twoface = sub { *twoface = *Backwards; $a <=> $b };
+}
eval { @b = sort twoface 4,1 };
print ($@ =~ /redefine active sort/ ? "ok 20\n" : "not ok 20\n");
-*twoface = sub {
+{
+ no warnings 'redefine';
+ *twoface = sub {
eval 'sub twoface { $a <=> $b }';
die($@ =~ /redefine active sort/ ? "ok 21\n" : "not ok 21\n");
$a <=> $b;
};
+}
eval { @b = sort twoface 4,1 };
print $@ ? "$@" : "not ok 21\n";
eval <<'CODE';
- my @result = sort main'backwards 'one', 'two';
+ my @result = sort main'Backwards 'one', 'two';
CODE
print $@ ? "not ok 22\n# $@" : "ok 22\n";
print $@ ? "not ok 23\n# $@" : "ok 23\n";
{
- my $sortsub = \&backwards;
- my $sortglob = *backwards;
- my $sortglobr = \*backwards;
- my $sortname = 'backwards';
+ my $sortsub = \&Backwards;
+ my $sortglob = *Backwards;
+ my $sortglobr = \*Backwards;
+ my $sortname = 'Backwards';
@b = sort $sortsub 4,1,3,2;
print ("@b" eq '4 3 2 1' ? "ok 24\n" : "not ok 24 |@b|\n");
@b = sort $sortglob 4,1,3,2;
}
{
- my $sortsub = \&backwards_stacked;
- my $sortglob = *backwards_stacked;
- my $sortglobr = \*backwards_stacked;
- my $sortname = 'backwards_stacked';
+ my $sortsub = \&Backwards_stacked;
+ my $sortglob = *Backwards_stacked;
+ my $sortglobr = \*Backwards_stacked;
+ my $sortname = 'Backwards_stacked';
@b = sort $sortsub 4,1,3,2;
print ("@b" eq '4 3 2 1' ? "ok 28\n" : "not ok 28 |@b|\n");
@b = sort $sortglob 4,1,3,2;
}
{
- local $sortsub = \&backwards;
- local $sortglob = *backwards;
- local $sortglobr = \*backwards;
- local $sortname = 'backwards';
+ local $sortsub = \&Backwards;
+ local $sortglob = *Backwards;
+ local $sortglobr = \*Backwards;
+ local $sortname = 'Backwards';
@b = sort $sortsub 4,1,3,2;
print ("@b" eq '4 3 2 1' ? "ok 32\n" : "not ok 32 |@b|\n");
@b = sort $sortglob 4,1,3,2;
}
{
- local $sortsub = \&backwards_stacked;
- local $sortglob = *backwards_stacked;
- local $sortglobr = \*backwards_stacked;
- local $sortname = 'backwards_stacked';
+ local $sortsub = \&Backwards_stacked;
+ local $sortglob = *Backwards_stacked;
+ local $sortglobr = \*Backwards_stacked;
+ local $sortname = 'Backwards_stacked';
@b = sort $sortsub 4,1,3,2;
print ("@b" eq '4 3 2 1' ? "ok 36\n" : "not ok 36 |@b|\n");
@b = sort $sortglob 4,1,3,2;
print ("@b" eq '1996 255 90 19 5' ? "ok 48\n" : "not ok 48\n");
print "# x = '@b'\n";
-@b = sort main::backwards_stacked @a;
+@b = sort main::Backwards_stacked @a;
print ("@b" eq '90 5 255 1996 19' ? "ok 49\n" : "not ok 49\n");
print "# x = '@b'\n";
# $RCSfile: sprintf.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:27 $
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+}
+use warnings;
+
print "1..4\n";
-$^W = 1;
$SIG{__WARN__} = sub {
if ($_[0] =~ /^Invalid conversion/) {
$w++;
unshift @INC, '../lib' if -d '../lib';
}
-BEGIN {$^W |= 1} # Insist upon warnings
+use warnings;
use vars qw{ @warnings };
BEGIN { # ...and save 'em for later
$SIG{'__WARN__'} = sub { push @warnings, @_ }
shift @warnings;
test 38, @warnings == 0, "unexpected warning";
-test 39, $^W & 1, "Who disabled the warnings?";
+test 39, 1;
use constant CSCALAR => \"ok 40\n";
use constant CHASH => { foo => "ok 41\n" };
@warnings = ();
eval q{
-{
+ no warnings;
use warnings 'constant';
use constant 'BEGIN' => 1 ;
use constant 'INIT' => 1 ;
use constant 'ENV' => 1 ;
use constant 'INC' => 1 ;
use constant 'SIG' => 1 ;
-}
};
test 59, @warnings == 14 ;
# even the default locale will taint under 'use locale'.
sub is_tainted { # hello, camel two.
- local $^W; # no warnings 'undef'
+ no warnings 'uninitialized' ;
my $dummy;
not eval { $dummy = join("", @_), kill 0; 1 }
}
tryneoalpha($Locale, 104, $c eq $d);
{
+ use warnings;
my $w = 0;
local $SIG{__WARN__} = sub { $w++ };
- local $^W = 1;
# the == (among other ops) used to warn for locales
# that had something else than "." as the radix character
projects / p5sagit/p5-mst-13.2.git / commitdiff