From: Gurusamy Sarathy Date: Mon, 13 Mar 2000 21:29:15 +0000 (+0000) Subject: lexical warnings update for docs and tests (from Paul Marquess) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9f1b1f2d9ab55954ee07a14c4ab04bd3dd1f99d5;p=p5sagit%2Fp5-mst-13.2.git lexical warnings update for docs and tests (from Paul Marquess) p4raw-id: //depot/perl@5712 --- diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm index 0e1382b..4b7e54b 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 5a84e28..ac45810 100644 --- a/lib/fields.pm +++ b/lib/fields.pm @@ -130,6 +130,7 @@ L 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 f954e10..f90696e 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 pragma (and the B<-w> switch) produces some +lovely diagnostics. See L for explanations of all Perl's diagnostics. The C pragma automatically turns Perl's normally terse warnings diff --git a/pod/perldata.pod b/pod/perldata.pod index e3361e4..96941bd 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 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. 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 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 faed2d2..3350596 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 372e1ff..b05b736 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 or used C<-w>? They enable warnings +for dubious practices. Have you tried C? 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 ad48245..b358a4e 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 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 0afbc0d..d51bf93 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) controls -runtime warnings for a block: +If you are running Perl 5.6.0 or better, the C pragma +allows fine control of what warning are produced. +See L 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) 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 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 @@ -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 bf287c0..c3c8315 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 3ddea3e..a9c7e48 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 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 994c3eb..63324a4 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -283,6 +283,7 @@ create a file called F 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 38044c9..c1f4aca 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 (or C). +Remember that you can add C 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 a81f7fe..1254948 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-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 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 to correct the incorrigible I 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 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 () { last unless $_; ... } In other boolean contexts, C<< > >> without an -explicit C test or comparison elicit a warning if the B<-w> +explicit C test or comparison elicit a warning if the +C 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 09bee37..e1f30a3 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 Cs. 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 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 274f43d..2727e95 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 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 5cc1969..f1e2c9a 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 and L. See also L and L. A new, fine-grained warning facility is also available if you want to manipulate entire classes -of warnings; see L (or better yet, its source code) about -that. +of warnings; see L or L. =item B<-W> diff --git a/pod/perlstyle.pod b/pod/perlstyle.pod index 04aab98..bfe5b76 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 pragma or the C<$^W> variable +if you must. You should also always run under C or know the reason why not. The C and even C 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 and B<-w> in effect. Consider giving away +code run cleanly with C and C (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 7b9590e..484af52 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -171,7 +171,8 @@ statements C, C, and C. 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 +praga or the B<-w> flag. Unlike a C statement, a C statement never implicitly localises any variables. diff --git a/pod/perltie.pod b/pod/perltie.pod index 9204052..c835738 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 +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 e528254..261a20f 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 > 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 pragma or the B<-w> switch. =head2 Discontinuance, Deprecation, and BugFix traps diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index c8e31bf..5333ac4 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 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 88c04ad..202aa57 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 531fc85..30db598 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 310967f..7709ee5 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 86323b6..2c936f1 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 00f7abb..b95cec5 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 ee7978e..04905cd 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 0b6f10f..9182273 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 0d5190a..7739276 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 09c566e..b336cb5 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 1434af1..188a3a3 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 6e3d2ca..794b1f2 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 70e55cb..4d54d2c 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 443bcf6..6438332 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 6265cce..414ceff 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