summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ext/File/Glob/Glob.pm2
-rw-r--r--lib/fields.pm4
-rw-r--r--pod/perl.pod3
-rw-r--r--pod/perldata.pod6
-rw-r--r--pod/perldbmfilter.pod5
-rw-r--r--pod/perlfaq3.pod3
-rw-r--r--pod/perlfaq4.pod5
-rw-r--r--pod/perlfaq7.pod18
-rw-r--r--pod/perlfilter.pod1
-rw-r--r--pod/perlipc.pod4
-rw-r--r--pod/perlmod.pod1
-rw-r--r--pod/perlmodlib.pod4
-rw-r--r--pod/perlop.pod11
-rw-r--r--pod/perlre.pod3
-rw-r--r--pod/perlref.pod3
-rw-r--r--pod/perlrun.pod3
-rw-r--r--pod/perlstyle.pod6
-rw-r--r--pod/perlsyn.pod3
-rw-r--r--pod/perltie.pod4
-rw-r--r--pod/perltrap.pod3
-rw-r--r--pod/perlunicode.pod3
-rw-r--r--pod/perlxstut.pod1
-rwxr-xr-xt/io/open.t7
-rwxr-xr-xt/lib/fields.t1
-rwxr-xr-xt/lib/parsewords.t54
-rwxr-xr-xt/op/assignwarn.t2
-rwxr-xr-xt/op/gv.t11
-rwxr-xr-xt/op/hashwarn.t3
-rwxr-xr-xt/op/magic.t3
-rwxr-xr-xt/op/pack.t2
-rwxr-xr-xt/op/pat.t4
-rwxr-xr-xt/op/sort.t67
-rwxr-xr-xt/op/sprintf.t7
-rwxr-xr-xt/pragma/constant.t7
-rwxr-xr-xt/pragma/locale.t4
35 files changed, 163 insertions, 105 deletions
diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm
index 0e1382b168..4b7e54b9e3 100644
--- a/ext/File/Glob/Glob.pm
+++ b/ext/File/Glob/Glob.pm
@@ -60,7 +60,7 @@ sub import {
$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;
diff --git a/lib/fields.pm b/lib/fields.pm
index 5a84e28f2e..ac4581036f 100644
--- a/lib/fields.pm
+++ b/lib/fields.pm
@@ -130,6 +130,7 @@ L<perlref/Pseudo-hashes: Using an array as a hash>
use 5.005_64;
use strict;
no strict 'refs';
+use warnings::register;
our(%attr, $VERSION);
$VERSION = "1.01";
@@ -171,7 +172,8 @@ sub import {
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");
}
diff --git a/pod/perl.pod b/pod/perl.pod
index f954e10e5f..f90696e8a8 100644
--- a/pod/perl.pod
+++ b/pod/perl.pod
@@ -392,7 +392,8 @@ Perl developers, please write to perl-thanks@perl.org .
=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
diff --git a/pod/perldata.pod b/pod/perldata.pod
index e3361e4dad..96941bd885 100644
--- a/pod/perldata.pod
+++ b/pod/perldata.pod
@@ -129,7 +129,8 @@ assignment to an array or hash evaluates the righthand side in list
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
@@ -366,7 +367,8 @@ A word that has no other interpretation in the grammar will
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
diff --git a/pod/perldbmfilter.pod b/pod/perldbmfilter.pod
index faed2d25d2..3350596aab 100644
--- a/pod/perldbmfilter.pod
+++ b/pod/perldbmfilter.pod
@@ -86,6 +86,7 @@ sure you have already guessed, this is a problem that DBM Filters can
fix very easily.
use strict ;
+ use warnings ;
use SDBM_File ;
use Fcntl ;
@@ -99,7 +100,8 @@ fix very easily.
# 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" ;
@@ -132,6 +134,7 @@ when reading.
Here is a DBM Filter that does it:
use strict ;
+ use warnings ;
use DB_File ;
my %hash ;
my $filename = "/tmp/filt" ;
diff --git a/pod/perlfaq3.pod b/pod/perlfaq3.pod
index 372e1ffda5..b05b7361c0 100644
--- a/pod/perlfaq3.pod
+++ b/pod/perlfaq3.pod
@@ -48,7 +48,8 @@ uninteresting, but may still be what you want.
=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
diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod
index ad4824577d..b358a4eaef 100644
--- a/pod/perlfaq4.pod
+++ b/pod/perlfaq4.pod
@@ -940,7 +940,8 @@ with
@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?
@@ -1070,7 +1071,7 @@ strings. Modify if you have other needs.
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];
diff --git a/pod/perlfaq7.pod b/pod/perlfaq7.pod
index 0afbc0dd34..d51bf93b10 100644
--- a/pod/perlfaq7.pod
+++ b/pod/perlfaq7.pod
@@ -84,8 +84,17 @@ Another way is to use undef as an element on the left-hand-side:
=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
@@ -95,10 +104,6 @@ runtime warnings for a block:
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>
@@ -168,6 +173,7 @@ own module. Make sure to change the names appropriately.
package Some::Module; # assumes Some/Module.pm
use strict;
+ use warnings;
BEGIN {
use Exporter ();
diff --git a/pod/perlfilter.pod b/pod/perlfilter.pod
index bf287c0873..c3c83153ad 100644
--- a/pod/perlfilter.pod
+++ b/pod/perlfilter.pod
@@ -410,6 +410,7 @@ Here is the complete Debug filter:
package Debug;
use strict;
+ use warnings;
use Filter::Util::Call ;
use constant TRUE => 1 ;
diff --git a/pod/perlipc.pod b/pod/perlipc.pod
index 3ddea3e41b..a9c7e48106 100644
--- a/pod/perlipc.pod
+++ b/pod/perlipc.pod
@@ -453,8 +453,8 @@ doesn't actually work:
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.
diff --git a/pod/perlmod.pod b/pod/perlmod.pod
index 994c3eb5dc..63324a41f4 100644
--- a/pod/perlmod.pod
+++ b/pod/perlmod.pod
@@ -283,6 +283,7 @@ create a file called F<Some/Module.pm> and start with this template:
package Some::Module; # assumes Some/Module.pm
use strict;
+ use warnings;
BEGIN {
use Exporter ();
diff --git a/pod/perlmodlib.pod b/pod/perlmodlib.pod
index 38044c9157..c1f4aca6be 100644
--- a/pod/perlmodlib.pod
+++ b/pod/perlmodlib.pod
@@ -1120,7 +1120,9 @@ scheme as the original author.
=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,
diff --git a/pod/perlop.pod b/pod/perlop.pod
index a81f7fe8b2..1254948871 100644
--- a/pod/perlop.pod
+++ b/pod/perlop.pod
@@ -1097,8 +1097,8 @@ Some frequently seen examples:
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
@@ -1458,8 +1458,8 @@ the result is not predictable.
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
@@ -1597,7 +1597,8 @@ to terminate the loop, they should be tested for explicitly:
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
diff --git a/pod/perlre.pod b/pod/perlre.pod
index 09bee37161..e1f30a324a 100644
--- a/pod/perlre.pod
+++ b/pod/perlre.pod
@@ -662,7 +662,8 @@ which uses C<< (?>...) >> matches exactly when the one above does (verifying
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<[^()]+ (?! [^()] )>.
diff --git a/pod/perlref.pod b/pod/perlref.pod
index 274f43d029..2727e95ae9 100644
--- a/pod/perlref.pod
+++ b/pod/perlref.pod
@@ -528,7 +528,8 @@ makes it more than a bareword:
$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.
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 5cc1969c60..f1e2c9a62e 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -701,8 +701,7 @@ can disable or promote into fatal errors specific warnings using
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>
diff --git a/pod/perlstyle.pod b/pod/perlstyle.pod
index 04aab9854a..bfe5b76713 100644
--- a/pod/perlstyle.pod
+++ b/pod/perlstyle.pod
@@ -10,7 +10,8 @@ make your programs easier to read, understand, and maintain.
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.
@@ -260,7 +261,8 @@ Line up your transliterations when it makes sense:
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.
diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod
index 7b9590e4de..484af52121 100644
--- a/pod/perlsyn.pod
+++ b/pod/perlsyn.pod
@@ -171,7 +171,8 @@ statements C<next>, C<last>, and C<redo>.
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.
diff --git a/pod/perltie.pod b/pod/perltie.pod
index 92040528e9..c835738573 100644
--- a/pod/perltie.pod
+++ b/pod/perltie.pod
@@ -743,6 +743,7 @@ a scalar.
package Remember;
use strict;
+ use warnings;
use IO::File;
sub TIESCALAR {
@@ -845,7 +846,8 @@ have not been flushed to disk.
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
diff --git a/pod/perltrap.pod b/pod/perltrap.pod
index e528254e0e..261a20fb03 100644
--- a/pod/perltrap.pod
+++ b/pod/perltrap.pod
@@ -393,7 +393,8 @@ Everything else.
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
diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod
index c8e31bf66c..5333ac495c 100644
--- a/pod/perlunicode.pod
+++ b/pod/perlunicode.pod
@@ -118,7 +118,8 @@ a Unicode smiley face is C<\x{263A}>. A character in the Latin-1 range
(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 *
diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod
index 88c04ad300..202aa570c4 100644
--- a/pod/perlxstut.pod
+++ b/pod/perlxstut.pod
@@ -114,6 +114,7 @@ The file Mytest.pm should start with something like this:
package Mytest;
use strict;
+ use warnings;
require Exporter;
require DynaLoader;
diff --git a/t/io/open.t b/t/io/open.t
index 531fc85ce3..30db5988b6 100755
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -1,8 +1,13 @@
#!./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";
diff --git a/t/lib/fields.t b/t/lib/fields.t
index 310967fcbe..7709ee5177 100755
--- a/t/lib/fields.t
+++ b/t/lib/fields.t
@@ -15,6 +15,7 @@ BEGIN {
}
use strict;
+use warnings;
use vars qw($DEBUG);
package B1;
diff --git a/t/lib/parsewords.t b/t/lib/parsewords.t
index 86323b6fc6..2c936f121f 100755
--- a/t/lib/parsewords.t
+++ b/t/lib/parsewords.t
@@ -5,6 +5,7 @@ BEGIN {
unshift @INC, '../lib';
}
+use warnings;
use Text::ParseWords;
print "1..18\n";
@@ -17,15 +18,15 @@ print "ok 2\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');
@@ -71,29 +72,30 @@ print "ok 11\n";
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;
diff --git a/t/op/assignwarn.t b/t/op/assignwarn.t
index 00f7abbf67..b95cec51a1 100755
--- a/t/op/assignwarn.t
+++ b/t/op/assignwarn.t
@@ -12,8 +12,8 @@ BEGIN {
}
use strict;
+use warnings;
-$^W = 1;
my $warn = "";
$SIG{q(__WARN__)} = sub { print $warn; $warn .= join("",@_) };
diff --git a/t/op/gv.t b/t/op/gv.t
index ee7978e046..04905cd400 100755
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -4,6 +4,13 @@
# various typeglob tests
#
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+}
+
+use warnings;
+
print "1..30\n";
# type coersion on assignment
@@ -62,7 +69,7 @@ if (defined $baa) {
# 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";
@@ -77,7 +84,7 @@ print +($foo || @foo || %foo) ? "not ok" : "ok", " 14\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;
diff --git a/t/op/hashwarn.t b/t/op/hashwarn.t
index 0b6f10feee..9182273ec3 100755
--- a/t/op/hashwarn.t
+++ b/t/op/hashwarn.t
@@ -6,12 +6,11 @@ BEGIN {
}
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";
diff --git a/t/op/magic.t b/t/op/magic.t
index 0d5190a2bb..7739276056 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -1,13 +1,14 @@
#!./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) {
diff --git a/t/op/pack.t b/t/op/pack.t
index 09c566e92f..b336cb549c 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -98,7 +98,7 @@ print((unpack("p",pack("p",$test)) == $test ? "ok " : "not ok "),$test++,"\n");
# 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/
diff --git a/t/op/pat.t b/t/op/pat.t
index 1434af1f06..188a3a3b13 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -573,8 +573,8 @@ sub must_warn_pat {
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++;
}
diff --git a/t/op/sort.t b/t/op/sort.t
index 6e3d2ca8e0..794b1f2a6c 100755
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -4,13 +4,17 @@ BEGIN {
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';
@@ -36,12 +40,12 @@ $expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain';
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");
@@ -77,13 +81,13 @@ print ("@b" eq "4 3 2 1" ? "ok 9\n" : "not ok 9 (@b)\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";
@@ -107,33 +111,38 @@ print "# x = '@b'\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";
@@ -144,10 +153,10 @@ CODE
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;
@@ -159,10 +168,10 @@ print $@ ? "not ok 23\n# $@" : "ok 23\n";
}
{
- 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;
@@ -174,10 +183,10 @@ print $@ ? "not ok 23\n# $@" : "ok 23\n";
}
{
- 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;
@@ -189,10 +198,10 @@ print $@ ? "not ok 23\n# $@" : "ok 23\n";
}
{
- 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;
@@ -249,6 +258,6 @@ package Foo;
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";
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 70e55cb6cb..4d54d2c317 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -2,9 +2,14 @@
# $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++;
diff --git a/t/pragma/constant.t b/t/pragma/constant.t
index 443bcf6423..6438332cff 100755
--- a/t/pragma/constant.t
+++ b/t/pragma/constant.t
@@ -5,7 +5,7 @@ BEGIN {
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, @_ }
@@ -135,7 +135,7 @@ test 37, @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" };
@@ -194,7 +194,7 @@ test 58, $constant::declared{'Other::IN_OTHER_PACK'};
@warnings = ();
eval q{
-{
+ no warnings;
use warnings 'constant';
use constant 'BEGIN' => 1 ;
use constant 'INIT' => 1 ;
@@ -210,7 +210,6 @@ eval q{
use constant 'ENV' => 1 ;
use constant 'INC' => 1 ;
use constant 'SIG' => 1 ;
-}
};
test 59, @warnings == 14 ;
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index 6265ccef1f..414ceffe96 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -52,7 +52,7 @@ sub ok {
# 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 }
}
@@ -582,9 +582,9 @@ foreach $Locale (@Locale) {
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
View Lorry Controller Status