diff options
| author | Jarkko Hietaniemi <jhi@iki.fi> | 1999-08-29 10:18:59 +0000 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 1999-08-29 10:18:59 +0000 |
| commit | 4438c4b75b842b6c829a7da9841e97abb875b1d8 (patch) | |
| tree | 559b1a700465df1cb1ae02ada9b9c9e48dd9539f | |
| parent | 6dd159d1401b9b9973dd00c1235374efbcb27144 (diff) | |
| download | perl-4438c4b75b842b6c829a7da9841e97abb875b1d8.tar.gz | |
Rename warning to warnings, from Paul Marquess.
p4raw-id: //depot/cfgperl@4038
46 files changed, 894 insertions, 641 deletions
@@ -874,7 +874,7 @@ lib/utf8.pm Pragma to control Unicode support lib/utf8_heavy.pl Support routines for utf8 pragma lib/validate.pl Perl library supporting wholesale file mode validation lib/vars.pm Declare pseudo-imported global variables -lib/warning.pm For "use warning" +lib/warnings.pm For "use warnings" makeaperl.SH perl script that produces a new perl binary makedef.pl Create symbol export lists for linking makedepend.SH Precursor to makedepend @@ -1343,37 +1343,39 @@ t/pragma/strict-vars Tests of "use strict 'vars'" for strict.t t/pragma/strict.t See if strictures work t/pragma/subs.t See if subroutine pseudo-importation works t/pragma/utf8.t See if utf8 operations work -t/pragma/warn/1global Tests of global warnings for warning.t -t/pragma/warn/2use Tests for "use warning" for warning.t -t/pragma/warn/3both Tests for interaction of $^W and "use warning" +t/pragma/warn/1global Tests of global warnings for warnings.t +t/pragma/warn/2use Tests for "use warnings" for warnings.t +t/pragma/warn/3both Tests for interaction of $^W and "use warnings" t/pragma/warn/4lint Tests for -W switch t/pragma/warn/5nolint Tests for -X switch t/pragma/warn/6default Tests default warnings -t/pragma/warn/av Tests for av.c for warning.t -t/pragma/warn/doio Tests for doio.c for warning.t -t/pragma/warn/doop Tests for doop.c for warning.t -t/pragma/warn/gv Tests for gv.c for warning.t -t/pragma/warn/hv Tests for hv.c for warning.t -t/pragma/warn/malloc Tests for malloc.c for warning.t -t/pragma/warn/mg Tests for mg.c for warning.t -t/pragma/warn/op Tests for op.c for warning.t -t/pragma/warn/perl Tests for perl.c for warning.t -t/pragma/warn/perlio Tests for perlio.c for warning.t -t/pragma/warn/perly Tests for perly.y for warning.t -t/pragma/warn/pp Tests for pp.c for warning.t -t/pragma/warn/pp_ctl Tests for pp_ctl.c for warning.t -t/pragma/warn/pp_hot Tests for pp_hot.c for warning.t -t/pragma/warn/pp_sys Tests for pp_sys.c for warning.t -t/pragma/warn/regcomp Tests for regcomp.c for warning.t -t/pragma/warn/regexec Tests for regexec.c for warning.t -t/pragma/warn/run Tests for run.c for warning.t -t/pragma/warn/sv Tests for sv.c for warning.t -t/pragma/warn/taint Tests for taint.c for warning.t -t/pragma/warn/toke Tests for toke.c for warning.t -t/pragma/warn/universal Tests for universal.c for warning.t -t/pragma/warn/utf8 Tests for utf8.c for warning.t -t/pragma/warn/util Tests for util.c for warning.t -t/pragma/warning.t See if warning controls work +t/pragma/warn/7fatal Tests fatal warnings +t/pragma/warn/8signal Tests warnings + __WARN__ and __DIE__ +t/pragma/warn/av Tests for av.c for warnings.t +t/pragma/warn/doio Tests for doio.c for warnings.t +t/pragma/warn/doop Tests for doop.c for warnings.t +t/pragma/warn/gv Tests for gv.c for warnings.t +t/pragma/warn/hv Tests for hv.c for warnings.t +t/pragma/warn/malloc Tests for malloc.c for warnings.t +t/pragma/warn/mg Tests for mg.c for warnings.t +t/pragma/warn/op Tests for op.c for warnings.t +t/pragma/warn/perl Tests for perl.c for warnings.t +t/pragma/warn/perlio Tests for perlio.c for warnings.t +t/pragma/warn/perly Tests for perly.y for warnings.t +t/pragma/warn/pp Tests for pp.c for warnings.t +t/pragma/warn/pp_ctl Tests for pp_ctl.c for warnings.t +t/pragma/warn/pp_hot Tests for pp_hot.c for warnings.t +t/pragma/warn/pp_sys Tests for pp_sys.c for warnings.t +t/pragma/warn/regcomp Tests for regcomp.c for warnings.t +t/pragma/warn/regexec Tests for regexec.c for warnings.t +t/pragma/warn/run Tests for run.c for warnings.t +t/pragma/warn/sv Tests for sv.c for warnings.t +t/pragma/warn/taint Tests for taint.c for warnings.t +t/pragma/warn/toke Tests for toke.c for warnings.t +t/pragma/warn/universal Tests for universal.c for warnings.t +t/pragma/warn/utf8 Tests for utf8.c for warnings.t +t/pragma/warn/util Tests for util.c for warnings.t +t/pragma/warnings.t See if warning controls work taint.c Tainting code thrdvar.h Per-thread variables thread.h Threading header @@ -1441,8 +1443,8 @@ vos/perl.bind VOS bind control file vos/test_vos_dummies.c Test program for "vos_dummies.c" vos/vos_dummies.c Wrappers to soak up undefined functions vos/vosish.h VOS-specific header file -warning.h The warning numbers -warning.pl Program to write warning.h and lib/warning.pm +warnings.h The warning numbers +warnings.pl Program to write warnings.h and lib/warnings.pm win32/Makefile Win32 makefile for NMAKE (Visual C++ build) win32/bin/perlglob.pl Win32 globbing win32/bin/pl2bat.pl wrap perl scripts into batch files diff --git a/Makefile.SH b/Makefile.SH index 6a84c1c15a..73a9b6faea 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -226,7 +226,7 @@ h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h -h5 = utf8.h warning.h +h5 = utf8.h warnings.h h = $(h1) $(h2) $(h3) $(h4) $(h5) c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c @@ -550,7 +550,7 @@ SYMH = perlvars.h intrpvar.h thrdvar.h # ext/B/Asmdata.pm: bytecode.pl # global.sym: embed.pl # regnodes.h: regcomp.pl -# warning.h lib/warning.pm: warning.pl +# warnings.h lib/warnings.pm: warnings.pl # The correct versions should be already supplied with the perl kit, # in case you don't have perl available. # To force them to run, type @@ -561,7 +561,7 @@ regen_headers: FORCE perl embed.pl perl bytecode.pl perl regcomp.pl - perl warning.pl + perl warnings.pl # Extensions: # Names added to $(dynamic_ext) or $(static_ext) or $(nonxs_ext) will @@ -757,7 +757,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case '/': case '|': case '\001': - case '\002': case '\003': case '\004': case '\005': @@ -767,7 +766,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case '\017': case '\020': case '\024': - case '\027': if (len > 1) break; goto magicalize; @@ -775,6 +773,10 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (len > 1) break; goto ro_magicalize; + case '\027': /* $^W & $^Warnings */ + if (len > 1 && strNE(name, "\027arnings")) + break; + goto magicalize; case '+': if (len > 1) diff --git a/lib/warning.pm b/lib/warnings.pm index 70ed91e56c..e15d364193 100644 --- a/lib/warning.pm +++ b/lib/warnings.pm @@ -1,21 +1,21 @@ -# This file was created by warning.pl +# This file was created by warnings.pl # Any changes made here will be lost. # -package warning; +package warnings; =head1 NAME -warning - Perl pragma to control optional warnings +warnings - Perl pragma to control optional warnings =head1 SYNOPSIS - use warning; - no warning; + use warnings; + no warnings; - use warning "all"; - no warning "all"; + use warnings "all"; + no warnings "all"; =head1 DESCRIPTION @@ -130,30 +130,12 @@ sub bits { sub import { shift; - $^B |= bits(@_ ? @_ : 'all') ; + ${^Warnings} |= bits(@_ ? @_ : 'all') ; } sub unimport { shift; - $^B &= ~ bits(@_ ? @_ : 'all') ; -} - - -sub make_fatal -{ - my $self = shift ; - my $bitmask = $self->bits(@_) ; - $SIG{__WARN__} = - sub - { - die @_ if $^B & $bitmask ; - warn @_ - } ; -} - -sub bitmask -{ - return $^B ; + ${^Warnings} &= ~ bits(@_ ? @_ : 'all') ; } sub enabled @@ -161,7 +143,7 @@ sub enabled my $string = shift ; return 1 - if $bits{$string} && $^B & $bits{$string} ; + if $bits{$string} && ${^Warnings} & $bits{$string} ; return 0 ; } @@ -400,19 +400,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '\001': /* ^A */ sv_setsv(sv, PL_bodytarget); break; - case '\002': /* ^B */ - if (PL_curcop->cop_warnings == WARN_NONE || - PL_curcop->cop_warnings == WARN_STD) - { - sv_setpvn(sv, WARN_NONEstring, WARNsize) ; - } - else if (PL_curcop->cop_warnings == WARN_ALL) { - sv_setpvn(sv, WARN_ALLstring, WARNsize) ; - } - else { - sv_setsv(sv, PL_curcop->cop_warnings); - } - break; case '\003': /* ^C */ sv_setiv(sv, (IV)PL_minus_c); break; @@ -504,8 +491,22 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setiv(sv, (IV)PL_basetime); #endif break; - case '\027': /* ^W */ - sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE)); + case '\027': /* ^W & $^Warnings*/ + if (*(mg->mg_ptr+1) == '\0') + sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE)); + else if (strEQ(mg->mg_ptr, "\027arnings")) { + if (PL_compiling.cop_warnings == WARN_NONE || + PL_compiling.cop_warnings == WARN_STD) + { + sv_setpvn(sv, WARN_NONEstring, WARNsize) ; + } + else if (PL_compiling.cop_warnings == WARN_ALL) { + sv_setpvn(sv, WARN_ALLstring, WARNsize) ; + } + else { + sv_setsv(sv, PL_compiling.cop_warnings); + } + } break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': @@ -1559,25 +1560,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case '\001': /* ^A */ sv_setsv(PL_bodytarget, sv); break; - case '\002': /* ^B */ - if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { - if (memEQ(SvPVX(sv), WARN_ALLstring, WARNsize)) { - PL_compiling.cop_warnings = WARN_ALL; - PL_dowarn |= G_WARN_ONCE ; - } - else if (memEQ(SvPVX(sv), WARN_NONEstring, WARNsize)) - PL_compiling.cop_warnings = WARN_NONE; - else { - if (specialWARN(PL_compiling.cop_warnings)) - PL_compiling.cop_warnings = newSVsv(sv) ; - else - sv_setsv(PL_compiling.cop_warnings, sv); - if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE)) - PL_dowarn |= G_WARN_ONCE ; - } - } - break; - case '\003': /* ^C */ PL_minus_c = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; @@ -1634,12 +1616,32 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); #endif break; - case '\027': /* ^W */ - if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { - i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); - PL_dowarn = (PL_dowarn & ~G_WARN_ON) + case '\027': /* ^W & $^Warnings */ + if (*(mg->mg_ptr+1) == '\0') { + if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { + i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + PL_dowarn = (PL_dowarn & ~G_WARN_ON) | (i ? G_WARN_ON : G_WARN_OFF) ; + } } + else if (strEQ(mg->mg_ptr, "\027arnings")) { + if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { + if (memEQ(SvPVX(sv), WARN_ALLstring, WARNsize)) { + PL_compiling.cop_warnings = WARN_ALL; + PL_dowarn |= G_WARN_ONCE ; + } + else if (memEQ(SvPVX(sv), WARN_NONEstring, WARNsize)) + PL_compiling.cop_warnings = WARN_NONE; + else { + if (specialWARN(PL_compiling.cop_warnings)) + PL_compiling.cop_warnings = newSVsv(sv) ; + else + sv_setsv(PL_compiling.cop_warnings, sv); + if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE)) + PL_dowarn |= G_WARN_ONCE ; + } + } + } break; case '.': if (PL_localizing) { @@ -1764,7 +1764,7 @@ typedef I32 (*filter_t) (pTHXo_ int, SV *, int); #include "hv.h" #include "mg.h" #include "scope.h" -#include "warning.h" +#include "warnings.h" #include "utf8.h" /* Current curly descriptor */ diff --git a/pod/perldelta.pod b/pod/perldelta.pod index f286a413d3..0cb375a3e7 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -127,7 +127,7 @@ scope. See L<utf8> for more information. =head2 Lexically scoped warning categories You can now control the granularity of warnings emitted by perl at a finer -level using the C<use warning> pragma. See L<warning> and L<perllexwarn> +level using the C<use warnings> pragma. See L<warnings> and L<perllexwarn> for details. =head2 Binary numbers supported @@ -546,7 +546,7 @@ C<use caller 'encoding'> allows modules to inherit pragmatic attributes from the caller's context. C<encoding> is currently the only supported attribute. -Lexical warnings pragma, C<use warning;>, to control optional warnings. +Lexical warnings pragma, C<use warnings;>, to control optional warnings. C<use filetest> to control the behaviour of filetests (C<-r> C<-w> ...). Currently only one subpragma implemented, "use filetest 'access';", diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 90439402a8..7077088b3c 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -18,8 +18,11 @@ desperation): Optional warnings are enabled by using the B<-w> switch. Warnings may be captured by setting C<$SIG{__WARN__}> to a reference to a routine that will be called on each warning instead of printing it. See L<perlvar>. + Trappable errors may be trapped using the eval operator. See -L<perlfunc/eval>. +L<perlfunc/eval>. In almost all cases, warnings may be selectively +disabled or promoted to fatal errors using the C<warnings> pragma. +See L<warnings>. Some of these messages are generic. Spots that vary are denoted with a %s, just as in a printf format. Note that some messages start with a %s! @@ -1374,7 +1377,7 @@ the name. (W) You redefined a format. To suppress this warning, say { - no warning; + no warnings; eval "format NAME =..."; } @@ -2656,7 +2659,7 @@ may break this. (W) You redefined a subroutine. To suppress this warning, say { - no warning; + no warnings; eval "sub name { ... }"; } diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 25c8efe27c..004c0f47cc 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4932,10 +4932,10 @@ are also implemented this way. Currently implemented pragmas are: use integer; use diagnostics; - use sigtrap qw(SEGV BUS); - use strict qw(subs vars refs); - use subs qw(afunc blurfl); - use warning qw(all); + use sigtrap qw(SEGV BUS); + use strict qw(subs vars refs); + use subs qw(afunc blurfl); + use warnings qw(all); Some of these pseudo-modules import semantics into the current block scope (like C<strict> or C<integer>, unlike ordinary modules, @@ -4947,7 +4947,7 @@ by C<use>, i.e., it calls C<unimport Module LIST> instead of C<import>. no integer; no strict 'refs'; - no warning; + no warnings; If no C<unimport> method can be found the call fails with a fatal error. diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod index b946654425..8dbae0ddbc 100644 --- a/pod/perllexwarn.pod +++ b/pod/perllexwarn.pod @@ -4,7 +4,7 @@ perllexwarn - Perl Lexical Warnings =head1 DESCRIPTION -The C<use warning> pragma is a replacement for both the command line +The C<use warnings> pragma is a replacement for both the command line flag B<-w> and the equivalent Perl variable, C<$^W>. The pragma works just like the existing "strict" pragma. @@ -19,21 +19,21 @@ doesn't attempt to control the warnings will work unchanged. All warnings are enabled in a block by either of these: - use warning ; - use warning 'all' ; + use warnings ; + use warnings 'all' ; Similarly all warnings are disabled in a block by either of these: - no warning ; - no warning 'all' ; + no warnings ; + no warnings 'all' ; For example, consider the code below: - use warning ; + use warnings ; my $a ; my $b ; { - no warning ; + no warnings ; $b = 2 if $a EQ 3 ; } $b = 1 if $a NE 3 ; @@ -65,7 +65,7 @@ example, in the code below, an C<"integer overflow"> warning will only be reported for the C<$a> variable. my $a = "2:" + 3; - no warning ; + no warnings ; my $b = "2:" + 3; Note that neither the B<-w> flag or the C<$^W> can be used to @@ -143,7 +143,7 @@ details of how this flag interacts with lexical warnings. If the B<-W> flag is used on the command line, it will enable all warnings throughout the program regardless of whether warnings were disabled -locally using C<no warning> or C<$^W =0>. This includes all files that get +locally using C<no warnings> or C<$^W =0>. This includes all files that get included via C<use>, C<require> or C<do>. Think of it as the Perl equivalent of the "lint" command. @@ -197,7 +197,7 @@ or B<-X> command line flags. =back The combined effect of 3 & 4 is that it will will allow code which uses -the lexical warning pragma to control the warning behavior of $^W-type +the lexical warnings pragma to control the warning behavior of $^W-type code (using a C<local $^W=0>) if it really wants to, but not vice-versa. =head1 EXPERIMENTAL FEATURES @@ -273,30 +273,37 @@ hierarchy is: | +--- misc - -Just like the "strict" pragma any of these categories can be -combined - use warning qw(void redefine) ; - no warning qw(io syntax untie) ; +Just like the "strict" pragma any of these categories can be combined + + use warnings qw(void redefine) ; + no warnings qw(io syntax untie) ; + +Also like the "strict" pragma, if there is more than one instance of the +warnings pragma in a given scope the cumulative effect is additive. + + use warnings qw(void) ; # only "void" warnings enabled + ... + use warnings qw(io) ; # only "void" & "io" warnings enabled + ... + no warnings qw(void) ; # only "io" warnings enabled + =head2 Fatal Warnings -This feature is B<very> experimental. - The presence of the word "FATAL" in the category list will escalate any -warnings from the category specified that are detected in the lexical -scope into fatal errors. In the code below, there are 3 places where -a deprecated warning will be detected, the middle one will produce a -fatal error. - - - use warning ; +warnings from the category/categories specified that are detected in +the lexical scope into fatal errors. In the code below, there are 3 +places where a deprecated warning will be detected, the middle one will +produce a fatal error. + + + use warnings ; $a = 1 if $a EQ $b ; { - use warning qw(FATAL deprecated) ; + use warnings FATAL => qw(deprecated) ; $a = 1 if $a EQ $b ; } @@ -319,7 +326,7 @@ The experimental features need bottomed out. =head1 SEE ALSO -L<warning>. +L<warnings>. =head1 AUTHOR diff --git a/pod/perlmodlib.pod b/pod/perlmodlib.pod index 79892344df..abfa657f61 100644 --- a/pod/perlmodlib.pod +++ b/pod/perlmodlib.pod @@ -30,7 +30,7 @@ by saying: no integer; no strict 'refs'; - no warning; + no warnings; which lasts until the end of that BLOCK. @@ -126,7 +126,7 @@ turn on UTF-8 and Unicode support predeclare global variable names -=item warning +=item warnings control optional warnings @@ -134,10 +134,6 @@ control optional warnings control VMS-specific language features -=item warning - -control optional warnings - =back =head2 Standard Modules diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 8a511ae930..0c3fcad921 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -692,7 +692,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<warning> (or better yet, its source code) about +of warnings; see L<warnings> (or better yet, its source code) about that. =item B<-W> diff --git a/pod/perltoc.pod b/pod/perltoc.pod index df44b38ffe..5842f18250 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -1599,7 +1599,7 @@ You want to temporarily change just one element of an array or hash attrs, autouse, base, blib, constant, diagnostics, fields, filetest, integer, less, lib, locale, ops, overload, re, sigtrap, strict, subs, utf8, -vars, vmsish, warning +vars, vmsish, warnings =item Standard Modules @@ -3488,7 +3488,7 @@ C<strict refs>, C<strict vars>, C<strict subs> =item DESCRIPTION -=head2 warning - Perl pragma to control optional warnings +=head2 warnings - Perl pragma to control optional warnings =item SYNOPSIS diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 3a38f553c6..d38bc4937d 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -686,13 +686,6 @@ of perl in the right bracket?) Example: See also the documentation of C<use VERSION> and C<require VERSION> for a convenient way to fail if the running Perl interpreter is too old. -=item $^B - -The current set of warning checks enabled by C<use warning>. -See the documentation of C<warning> for more details. - -Used by lexical warnings to store the - =item $COMPILING =item $^C @@ -821,7 +814,12 @@ and B<-C> filetests are based on this value. The current value of the warning switch, initially true if B<-w> was used, false otherwise, but directly modifiable. (Mnemonic: -related to the B<-w> switch.) See also L<warning>. +related to the B<-w> switch.) See also L<warnings>. + +=item ${^Warnings} + +The current set of warning checks enabled by the C<use warnings> pragma. +See the documentation of C<warnings> for more details. =item $EXECUTABLE_NAME @@ -970,7 +968,7 @@ Carp was available. The third line will be executed only if Carp was not available. See L<perlfunc/die>, L<perlfunc/warn>, L<perlfunc/eval>, and -L<warning> for additional information. +L<warnings> for additional information. =back diff --git a/t/op/64bit.t b/t/op/64bit.t index d35254be24..5625b4fa13 100644 --- a/t/op/64bit.t +++ b/t/op/64bit.t @@ -15,7 +15,7 @@ BEGIN { # so that using > 0xfffffff constants and # 32+ bit vector sizes doesn't cause noise -no warning qw(overflow portable); +no warnings qw(overflow portable); print "1..39\n"; diff --git a/t/op/tie.t b/t/op/tie.t index 49f07d4d2d..105b1d6f18 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -77,7 +77,7 @@ EXPECT ######## # strict behaviour, without any extra references -use warning 'untie'; +use warnings 'untie'; #local $^W = 1 ; use Tie::Hash ; tie %h, Tie::StdHash; @@ -86,7 +86,7 @@ EXPECT ######## # strict behaviour, with 1 extra references generating an error -use warning 'untie'; +use warnings 'untie'; #local $^W = 1 ; use Tie::Hash ; $a = tie %h, Tie::StdHash; @@ -96,7 +96,7 @@ untie attempted while 1 inner references still exist ######## # strict behaviour, with 1 extra references via tied generating an error -use warning 'untie'; +use warnings 'untie'; #local $^W = 1 ; use Tie::Hash ; tie %h, Tie::StdHash; @@ -107,7 +107,7 @@ untie attempted while 1 inner references still exist ######## # strict behaviour, with 1 extra references which are destroyed -use warning 'untie'; +use warnings 'untie'; #local $^W = 1 ; use Tie::Hash ; $a = tie %h, Tie::StdHash; @@ -117,7 +117,7 @@ EXPECT ######## # strict behaviour, with extra 1 references via tied which are destroyed -use warning 'untie'; +use warnings 'untie'; #local $^W = 1 ; use Tie::Hash ; tie %h, Tie::StdHash; @@ -128,7 +128,7 @@ EXPECT ######## # strict error behaviour, with 2 extra references -use warning 'untie'; +use warnings 'untie'; #local $^W = 1 ; use Tie::Hash ; $a = tie %h, Tie::StdHash; @@ -139,13 +139,13 @@ untie attempted while 2 inner references still exist ######## # strict behaviour, check scope of strictness. -no warning 'untie'; +no warnings 'untie'; #local $^W = 0 ; use Tie::Hash ; $A = tie %H, Tie::StdHash; $C = $B = tied %H ; { - use warning 'untie'; + use warnings 'untie'; #local $^W = 1 ; use Tie::Hash ; tie %h, Tie::StdHash; diff --git a/t/pragma/warn/2use b/t/pragma/warn/2use index 764a843192..4ec4da0a77 100644 --- a/t/pragma/warn/2use +++ b/t/pragma/warn/2use @@ -1,4 +1,4 @@ -Check lexical warning functionality +Check lexical warnings functionality TODO check that the warning hierarchy works. @@ -6,16 +6,16 @@ TODO __END__ # check illegal category is caught -use warning 'blah' ; +use warnings 'blah' ; EXPECT unknown warning category 'blah' at - line 3 BEGIN failed--compilation aborted at - line 3. ######## # Check compile time scope of pragma -use warning 'deprecated' ; +use warnings 'deprecated' ; { - no warning ; + no warnings ; 1 if $a EQ $b ; } 1 if $a EQ $b ; @@ -24,9 +24,9 @@ Use of EQ is deprecated at - line 8. ######## # Check compile time scope of pragma -no warning; +no warnings; { - use warning 'deprecated' ; + use warnings 'deprecated' ; 1 if $a EQ $b ; } 1 if $a EQ $b ; @@ -35,9 +35,9 @@ Use of EQ is deprecated at - line 6. ######## # Check runtime scope of pragma -use warning 'uninitialized' ; +use warnings 'uninitialized' ; { - no warning ; + no warnings ; my $b ; chop $b ; } my $b ; chop $b ; @@ -46,9 +46,9 @@ Use of uninitialized value at - line 8. ######## # Check runtime scope of pragma -no warning ; +no warnings ; { - use warning 'uninitialized' ; + use warnings 'uninitialized' ; my $b ; chop $b ; } my $b ; chop $b ; @@ -57,9 +57,9 @@ Use of uninitialized value at - line 6. ######## # Check runtime scope of pragma -no warning ; +no warnings ; { - use warning 'uninitialized' ; + use warnings 'uninitialized' ; $a = sub { my $b ; chop $b ; } } &$a ; @@ -67,7 +67,7 @@ EXPECT Use of uninitialized value at - line 6. ######## -use warning 'deprecated' ; +use warnings 'deprecated' ; 1 if $a EQ $b ; EXPECT Use of EQ is deprecated at - line 3. @@ -77,14 +77,14 @@ Use of EQ is deprecated at - line 3. 1 if $a EQ $b ; 1; --FILE-- -use warning 'deprecated' ; +use warnings 'deprecated' ; require "./abc"; EXPECT ######## --FILE-- abc -use warning 'deprecated' ; +use warnings 'deprecated' ; 1; --FILE-- require "./abc"; @@ -94,11 +94,11 @@ EXPECT ######## --FILE-- abc -use warning 'deprecated' ; +use warnings 'deprecated' ; 1 if $a EQ $b ; 1; --FILE-- -use warning 'uninitialized' ; +use warnings 'uninitialized' ; require "./abc"; my $a ; chop $a ; EXPECT @@ -107,11 +107,11 @@ Use of uninitialized value at - line 3. ######## --FILE-- abc.pm -use warning 'deprecated' ; +use warnings 'deprecated' ; 1 if $a EQ $b ; 1; --FILE-- -use warning 'uninitialized' ; +use warnings 'uninitialized' ; use abc; my $a ; chop $a ; EXPECT @@ -120,7 +120,7 @@ Use of uninitialized value at - line 3. ######## # Check scope of pragma with eval -no warning ; +no warnings ; eval { my $b ; chop $b ; }; print STDERR $@ ; @@ -130,9 +130,9 @@ EXPECT ######## # Check scope of pragma with eval -no warning ; +no warnings ; eval { - use warning 'uninitialized' ; + use warnings 'uninitialized' ; my $b ; chop $b ; }; print STDERR $@ ; my $b ; chop $b ; @@ -141,7 +141,7 @@ Use of uninitialized value at - line 6. ######## # Check scope of pragma with eval -use warning 'uninitialized' ; +use warnings 'uninitialized' ; eval { my $b ; chop $b ; }; print STDERR $@ ; @@ -152,9 +152,9 @@ Use of uninitialized value at - line 7. ######## # Check scope of pragma with eval -use warning 'uninitialized' ; +use warnings 'uninitialized' ; eval { - no warning ; + no warnings ; my $b ; chop $b ; }; print STDERR $@ ; my $b ; chop $b ; @@ -163,7 +163,7 @@ Use of uninitialized value at - line 8. ######## # Check scope of pragma with eval -no warning ; +no warnings ; eval { 1 if $a EQ $b ; }; print STDERR $@ ; @@ -173,9 +173,9 @@ EXPECT ######## # Check scope of pragma with eval -no warning ; +no warnings ; eval { - use warning 'deprecated' ; + use warnings 'deprecated' ; 1 if $a EQ $b ; }; print STDERR $@ ; 1 if $a EQ $b ; @@ -184,7 +184,7 @@ Use of EQ is deprecated at - line 6. ######## # Check scope of pragma with eval -use warning 'deprecated' ; +use warnings 'deprecated' ; eval { 1 if $a EQ $b ; }; print STDERR $@ ; @@ -195,9 +195,9 @@ Use of EQ is deprecated at - line 7. ######## # Check scope of pragma with eval -use warning 'deprecated' ; +use warnings 'deprecated' ; eval { - no warning ; + no warnings ; 1 if $a EQ $b ; }; print STDERR $@ ; 1 if $a EQ $b ; @@ -206,7 +206,7 @@ Use of EQ is deprecated at - line 8. ######## # Check scope of pragma with eval -no warning ; +no warnings ; eval ' my $b ; chop $b ; '; print STDERR $@ ; @@ -216,9 +216,9 @@ EXPECT ######## # Check scope of pragma with eval -no warning ; +no warnings ; eval q[ - use warning 'uninitialized' ; + use warnings 'uninitialized' ; my $b ; chop $b ; ]; print STDERR $@; my $b ; chop $b ; @@ -227,7 +227,7 @@ Use of uninitialized value at (eval 1) line 3. ######## # Check scope of pragma with eval -use warning 'uninitialized' ; +use warnings 'uninitialized' ; eval ' my $b ; chop $b ; '; print STDERR $@ ; @@ -238,9 +238,9 @@ Use of uninitialized value at - line 7. ######## # Check scope of pragma with eval -use warning 'uninitialized' ; +use warnings 'uninitialized' ; eval ' - no warning ; + no warnings ; my $b ; chop $b ; '; print STDERR $@ ; my $b ; chop $b ; @@ -249,7 +249,7 @@ Use of uninitialized value at - line 8. ######## # Check scope of pragma with eval -no warning ; +no warnings ; eval ' 1 if $a EQ $b ; '; print STDERR $@ ; @@ -259,9 +259,9 @@ EXPECT ######## # Check scope of pragma with eval -no warning ; +no warnings ; eval q[ - use warning 'deprecated' ; + use warnings 'deprecated' ; 1 if $a EQ $b ; ]; print STDERR $@; 1 if $a EQ $b ; @@ -270,7 +270,7 @@ Use of EQ is deprecated at (eval 1) line 3. ######## # Check scope of pragma with eval -use warning 'deprecated' ; +use warnings 'deprecated' ; eval ' 1 if $a EQ $b ; '; print STDERR $@; @@ -281,11 +281,28 @@ Use of EQ is deprecated at (eval 1) line 2. ######## # Check scope of pragma with eval -use warning 'deprecated' ; +use warnings 'deprecated' ; eval ' - no warning ; + no warnings ; 1 if $a EQ $b ; '; print STDERR $@; 1 if $a EQ $b ; EXPECT Use of EQ is deprecated at - line 8. +######## + +# Check the additive nature of the pragma +1 if $a EQ $b ; +my $a ; chop $a ; +use warnings 'deprecated' ; +1 if $a EQ $b ; +my $b ; chop $b ; +use warnings 'uninitialized' ; +my $c ; chop $c ; +no warnings 'deprecated' ; +1 if $a EQ $b ; +EXPECT +Use of EQ is deprecated at - line 6. +Use of uninitialized value at - line 9. +Use of uninitialized value at - line 11. +Use of uninitialized value at - line 11. diff --git a/t/pragma/warn/3both b/t/pragma/warn/3both index 1d7deb8636..592724ad73 100644 --- a/t/pragma/warn/3both +++ b/t/pragma/warn/3both @@ -2,9 +2,9 @@ Check interaction of $^W and lexical __END__ -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings sub fred { - use warning ; + use warnings ; my $b ; chop $b ; } @@ -16,9 +16,9 @@ EXPECT Use of uninitialized value at - line 6. ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings sub fred { - use warning ; + use warnings ; my $b ; chop $b ; } @@ -30,9 +30,9 @@ EXPECT Use of uninitialized value at - line 6. ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings sub fred { - no warning ; + no warnings ; my $b ; chop $b ; } @@ -44,9 +44,9 @@ EXPECT ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings sub fred { - no warning ; + no warnings ; my $b ; chop $b ; } @@ -58,8 +58,8 @@ EXPECT ######## -# Check interaction of $^W and use warning -use warning ; +# Check interaction of $^W and use warnings +use warnings ; $^W = 1 ; my $b ; chop $b ; @@ -67,26 +67,26 @@ EXPECT Use of uninitialized value at - line 6. ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings $^W = 1 ; -use warning ; +use warnings ; my $b ; chop $b ; EXPECT Use of uninitialized value at - line 6. ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings $^W = 1 ; -no warning ; +no warnings ; my $b ; chop $b ; EXPECT ######## -# Check interaction of $^W and use warning -no warning ; +# Check interaction of $^W and use warnings +no warnings ; $^W = 1 ; my $b ; chop $b ; @@ -94,25 +94,25 @@ EXPECT ######## -w -# Check interaction of $^W and use warning -no warning ; +# Check interaction of $^W and use warnings +no warnings ; my $b ; chop $b ; EXPECT ######## -w -# Check interaction of $^W and use warning -use warning ; +# Check interaction of $^W and use warnings +use warnings ; my $b ; chop $b ; EXPECT Use of uninitialized value at - line 5. ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings sub fred { - use warning ; + use warnings ; my $b ; chop $b ; } @@ -122,9 +122,9 @@ EXPECT Use of uninitialized value at - line 6. ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings sub fred { - no warning ; + no warnings ; my $b ; chop $b ; } @@ -135,8 +135,8 @@ EXPECT ######## -# Check interaction of $^W and use warning -use warning ; +# Check interaction of $^W and use warnings +use warnings ; BEGIN { $^W = 1 } my $b ; chop $b ; @@ -144,26 +144,26 @@ EXPECT Use of uninitialized value at - line 6. ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings BEGIN { $^W = 1 } -use warning ; +use warnings ; my $b ; chop $b ; EXPECT Use of uninitialized value at - line 6. ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings BEGIN { $^W = 1 } -no warning ; +no warnings ; my $b ; chop $b ; EXPECT ######## -# Check interaction of $^W and use warning -no warning ; +# Check interaction of $^W and use warnings +no warnings ; BEGIN { $^W = 1 } my $b ; chop $b ; @@ -171,10 +171,10 @@ EXPECT ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings BEGIN { $^W = 1 } { - no warning ; + no warnings ; my $b ; chop $b ; } @@ -184,10 +184,10 @@ EXPECT Use of uninitialized value at - line 10. ######## -# Check interaction of $^W and use warning +# Check interaction of $^W and use warnings BEGIN { $^W = 0 } { - use warning ; + use warnings ; my $b ; chop $b ; } diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint index 87cd7dc967..6a08409bb2 100644 --- a/t/pragma/warn/4lint +++ b/t/pragma/warn/4lint @@ -28,8 +28,8 @@ EXPECT print on closed filehandle main::STDIN at - line 5. ######## -W -# lint: check "no warning" is zapped -no warning ; +# lint: check "no warnings" is zapped +no warnings ; $a = $b = 1 ; $a = 1 if $a EQ $b ; close STDIN ; print STDIN "abc" ; @@ -38,9 +38,9 @@ Use of EQ is deprecated at - line 5. print on closed filehandle main::STDIN at - line 6. ######## -W -# lint: check "no warning" is zapped +# lint: check "no warnings" is zapped { - no warning ; + no warnings ; close STDIN ; print STDIN "abc" ; } EXPECT @@ -57,12 +57,12 @@ print on closed filehandle main::STDIN at - line 5. ######## -W --FILE-- abc.pm -no warning 'deprecated' ; +no warnings 'deprecated' ; my ($a, $b) = (0,0); 1 if $a EQ $b ; 1; --FILE-- -no warning 'uninitialized' ; +no warnings 'uninitialized' ; use abc; my $a ; chop $a ; EXPECT @@ -71,12 +71,12 @@ Use of uninitialized value at - line 3. ######## -W --FILE-- abc -no warning 'deprecated' ; +no warnings 'deprecated' ; my ($a, $b) = (0,0); 1 if $a EQ $b ; 1; --FILE-- -no warning 'uninitialized' ; +no warnings 'uninitialized' ; require "./abc"; my $a ; chop $a ; EXPECT diff --git a/t/pragma/warn/5nolint b/t/pragma/warn/5nolint index 979423e87e..994190a855 100644 --- a/t/pragma/warn/5nolint +++ b/t/pragma/warn/5nolint @@ -24,17 +24,17 @@ EXPECT EXPECT ######## -X -# nolint: check "no warning" is zapped -use warning ; +# nolint: check "no warnings" is zapped +use warnings ; $a = $b = 1 ; $a = 1 if $a EQ $b ; close STDIN ; print STDIN "abc" ; EXPECT ######## -X -# nolint: check "no warning" is zapped +# nolint: check "no warnings" is zapped { - use warning ; + use warnings ; close STDIN ; print STDIN "abc" ; } EXPECT @@ -49,24 +49,24 @@ EXPECT ######## -X --FILE-- abc.pm -use warning 'deprecated' ; +use warnings 'deprecated' ; my ($a, $b) = (0,0); 1 if $a EQ $b ; 1; --FILE-- -use warning 'uninitialized' ; +use warnings 'uninitialized' ; use abc; my $a ; chop $a ; EXPECT ######## -X --FILE-- abc -use warning 'deprecated' ; +use warnings 'deprecated' ; my ($a, $b) = (0,0); 1 if $a EQ $b ; 1; --FILE-- -use warning 'uninitialized' ; +use warnings 'uninitialized' ; require "./abc"; my $a ; chop $a ; EXPECT diff --git a/t/pragma/warn/6default b/t/pragma/warn/6default index 5be41124ca..dd3d1825f4 100644 --- a/t/pragma/warn/6default +++ b/t/pragma/warn/6default @@ -1,19 +1,19 @@ Check default warnings __END__ -# default warning should be displayed if you don't add anything +# default warnings should be displayed if you don't add anything # optional shouldn't my $a = oct "7777777777777777777777777777777777779" ; EXPECT Integer overflow in octal number at - line 3. ######## -# no warning should be displayed -no warning ; +# no warnings should be displayed +no warnings ; my $a = oct "7777777777777777777777777777777777778" ; EXPECT ######## -# all warning should be displayed -use warning ; +# all warnings should be displayed +use warnings ; my $a = oct "7777777777777777777777777777777777778" ; EXPECT Integer overflow in octal number at - line 3. @@ -21,10 +21,10 @@ Illegal octal digit '8' ignored at - line 3. Octal number > 037777777777 non-portable at - line 3. ######## # check scope -use warning ; +use warnings ; my $a = oct "7777777777777777777777777777777777778" ; { - no warning ; + no warnings ; my $a = oct "7777777777777777777777777777777777778" ; } my $c = oct "7777777777777777777777777777777777778" ; @@ -36,16 +36,16 @@ Integer overflow in octal number at - line 8. Illegal octal digit '8' ignored at - line 8. Octal number > 037777777777 non-portable at - line 8. ######## -# all warning should be displayed -use warning ; +# all warnings should be displayed +use warnings ; my $a = oct "0xfffffffffffffffffg" ; EXPECT Integer overflow in hexadecimal number at - line 3. Illegal hexadecimal digit 'g' ignored at - line 3. Hexadecimal number > 0xffffffff non-portable at - line 3. ######## -# all warning should be displayed -use warning ; +# all warnings should be displayed +use warnings ; my $a = oct "0b111111111111111111111111111111111111111111111111111111111111111112"; EXPECT Integer overflow in binary number at - line 3. diff --git a/t/pragma/warn/7fatal b/t/pragma/warn/7fatal new file mode 100644 index 0000000000..fe94511f3e --- /dev/null +++ b/t/pragma/warn/7fatal @@ -0,0 +1,242 @@ +Check FATAL functionality + +__END__ + +# Check compile time warning +use warnings FATAL => 'deprecated' ; +{ + no warnings ; + 1 if $a EQ $b ; +} +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 8. +######## + +# Check runtime scope of pragma +use warnings FATAL => 'uninitialized' ; +{ + no warnings ; + my $b ; chop $b ; +} +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value at - line 8. +######## + +# Check runtime scope of pragma +no warnings ; +{ + use warnings FATAL => 'uninitialized' ; + $a = sub { my $b ; chop $b ; } +} +&$a ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value at - line 6. +######## + +--FILE-- abc +1 if $a EQ $b ; +1; +--FILE-- +use warnings FATAL => 'deprecated' ; +require "./abc"; +EXPECT + +######## + +--FILE-- abc +use warnings FATAL => 'deprecated' ; +1; +--FILE-- +require "./abc"; +1 if $a EQ $b ; +EXPECT + +######## + +--FILE-- abc +use warnings 'deprecated' ; +1 if $a EQ $b ; +1; +--FILE-- +use warnings FATAL => 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at ./abc line 2. +Use of uninitialized value at - line 3. +######## + +--FILE-- abc.pm +use warnings 'deprecated' ; +1 if $a EQ $b ; +1; +--FILE-- +use warnings FATAL => 'uninitialized' ; +use abc; +my $a ; chop $a ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at abc.pm line 2. +Use of uninitialized value at - line 3. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings FATAL => 'uninitialized' ; + my $b ; chop $b ; +}; print STDERR "-- $@" ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value at - line 6. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval { + my $b ; chop $b ; +}; print STDERR "-- $@" ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value at - line 5. +Use of uninitialized value at - line 7. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval { + no warnings ; + my $b ; chop $b ; +}; print STDERR $@ ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value at - line 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings FATAL => 'deprecated' ; + 1 if $a EQ $b ; +}; print STDERR "-- $@" ; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 6. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'deprecated' ; +eval { + 1 if $a EQ $b ; +}; print STDERR "-- $@" ; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 5. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'deprecated' ; +eval { + no warnings ; + 1 if $a EQ $b ; +}; print STDERR $@ ; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings FATAL => 'deprecated' ; +}; print STDERR $@ ; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +The End. +######## + +# Check scope of pragma with eval +no warnings ; +eval q[ + use warnings FATAL => 'uninitialized' ; + my $b ; chop $b ; +]; print STDERR "-- $@"; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value at (eval 1) line 3. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval ' + my $b ; chop $b ; +'; print STDERR "-- $@" ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value at (eval 1) line 2. +Use of uninitialized value at - line 7. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval ' + no warnings ; + my $b ; chop $b ; +'; print STDERR $@ ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value at - line 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval q[ + use warnings FATAL => 'deprecated' ; + 1 if $a EQ $b ; +]; print STDERR "-- $@"; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of EQ is deprecated at (eval 1) line 3. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'deprecated' ; +eval ' + 1 if $a EQ $b ; +'; print STDERR "-- $@"; +print STDERR "The End.\n" ; +EXPECT +-- Use of EQ is deprecated at (eval 1) line 2. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'deprecated' ; +eval ' + no warnings ; + 1 if $a EQ $b ; +'; print STDERR "-- $@"; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 8. diff --git a/t/pragma/warn/8signal b/t/pragma/warn/8signal new file mode 100644 index 0000000000..0be2d13cc0 --- /dev/null +++ b/t/pragma/warn/8signal @@ -0,0 +1,18 @@ +Check interaction of __WARN__, __DIE__ & lexical Warnings + +TODO + +__END__ +# 8signal +BEGIN { $SIG{__WARN__} = sub { print "WARN -- @_" } } +BEGIN { $SIG{__DIE__} = sub { print "DIE -- @_" } } +1 if 1 EQ 2 ; +use warnings qw(deprecated) ; +1 if 1 EQ 2 ; +use warnings FATAL => qw(deprecated) ; +1 if 1 EQ 2 ; +print "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 8. +WARN -- Use of EQ is deprecated at - line 6. +DIE -- Use of EQ is deprecated at - line 8. diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio index 5bcca8d78c..e6de782686 100644 --- a/t/pragma/warn/doio +++ b/t/pragma/warn/doio @@ -55,47 +55,47 @@ __END__ # doio.c -use warning 'io' ; +use warnings 'io' ; open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); close(F); -no warning 'io' ; +no warnings 'io' ; open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); close(G); EXPECT Can't do bidirectional pipe at - line 3. ######## # doio.c -use warning 'io' ; +use warnings 'io' ; open(F, "| "); -no warning 'io' ; +no warnings 'io' ; open(G, "| "); EXPECT Missing command in piped open at - line 3. ######## # doio.c -use warning 'io' ; +use warnings 'io' ; open(F, " |"); -no warning 'io' ; +no warnings 'io' ; open(G, " |"); EXPECT Missing command in piped open at - line 3. ######## # doio.c -use warning 'io' ; +use warnings 'io' ; open(F, "<true\ncd"); -no warning 'io' ; +no warnings 'io' ; open(G, "<true\ncd"); EXPECT Unsuccessful open on filename containing newline at - line 3. ######## # doio.c -use warning 'io' ; +use warnings 'io' ; close STDIN ; tell(STDIN); $a = seek(STDIN,1,1); $a = sysseek(STDIN,1,1); -x STDIN ; -no warning 'io' ; +no warnings 'io' ; close STDIN ; tell(STDIN); $a = seek(STDIN,1,1); @@ -108,24 +108,24 @@ sysseek() on unopened file at - line 6. Stat on unopened file <STDIN> at - line 7. ######## # doio.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; print $a ; -no warning 'uninitialized' ; +no warnings 'uninitialized' ; print $b ; EXPECT Use of uninitialized value at - line 3. ######## # doio.c -use warning 'io' ; +use warnings 'io' ; EXPECT ######## # doio.c -use warning 'io' ; +use warnings 'io' ; stat "ab\ncd"; lstat "ab\ncd"; -no warning 'io' ; +no warnings 'io' ; stat "ab\ncd"; lstat "ab\ncd"; EXPECT @@ -133,18 +133,18 @@ Unsuccessful stat on filename containing newline at - line 3. Unsuccessful stat on filename containing newline at - line 4. ######## # doio.c -use warning 'io' ; +use warnings 'io' ; exec "lskdjfalksdjfdjfkls","" ; -no warning 'io' ; +no warnings 'io' ; exec "lskdjfalksdjfdjfkls","" ; EXPECT OPTION regex Can't exec "lskdjfalksdjfdjfkls": .+ ######## # doio.c -use warning 'io' ; +use warnings 'io' ; exec "lskdjfalksdjfdjfkls", "abc" ; -no warning 'io' ; +no warnings 'io' ; exec "lskdjfalksdjfdjfkls", "abc" ; EXPECT OPTION regex @@ -161,13 +161,13 @@ mkdir $filename, 0777 my $x = <> ; } { - no warning 'inplace' ; + no warnings 'inplace' ; local (@ARGV) = ($filename) ; local ($^I) = "" ; my $x = <> ; } { - use warning 'inplace' ; + use warnings 'inplace' ; local (@ARGV) = ($filename) ; local ($^I) = "" ; my $x = <> ; diff --git a/t/pragma/warn/doop b/t/pragma/warn/doop index 458a3b2803..961d157502 100644 --- a/t/pragma/warn/doop +++ b/t/pragma/warn/doop @@ -12,11 +12,11 @@ EXPECT Malformed UTF-8 character at - line 4. ######## # doop.c -use warning 'utf8' ; +use warnings 'utf8' ; use utf8 ; $_ = "\x80 \xff" ; chop ; -no warning 'utf8' ; +no warnings 'utf8' ; $_ = "\x80 \xff" ; chop ; EXPECT diff --git a/t/pragma/warn/gv b/t/pragma/warn/gv index e33f8ca04f..5ed4eca018 100644 --- a/t/pragma/warn/gv +++ b/t/pragma/warn/gv @@ -22,14 +22,14 @@ __END__ # gv.c -use warning 'misc' ; +use warnings 'misc' ; @ISA = qw(Fred); joe() EXPECT Can't locate package Fred for @main::ISA at - line 3. Undefined subroutine &main::joe called at - line 3. ######## # gv.c -no warning 'misc' ; +no warnings 'misc' ; @ISA = qw(Fred); joe() EXPECT Undefined subroutine &main::joe called at - line 3. @@ -37,16 +37,16 @@ Undefined subroutine &main::joe called at - line 3. # gv.c sub Other::AUTOLOAD { 1 } sub Other::fred {} @ISA = qw(Other) ; -use warning 'deprecated' ; +use warnings 'deprecated' ; fred() ; EXPECT Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5. ######## # gv.c -use warning 'deprecated' ; +use warnings 'deprecated' ; $a = ${"#"}; $a = ${"*"}; -no warning 'deprecated' ; +no warnings 'deprecated' ; $a = ${"#"}; $a = ${"*"}; EXPECT diff --git a/t/pragma/warn/mg b/t/pragma/warn/mg index 7f40ded7f8..a8f9dbc338 100644 --- a/t/pragma/warn/mg +++ b/t/pragma/warn/mg @@ -12,19 +12,19 @@ __END__ # mg.c -use warning 'signal' ; +use warnings 'signal' ; $SIG{FRED} = sub {}; EXPECT No such signal: SIGFRED at - line 3. ######## # mg.c -no warning 'signal' ; +no warnings 'signal' ; $SIG{FRED} = sub {}; EXPECT ######## # mg.c -use warning 'signal' ; +use warnings 'signal' ; if ($^O eq 'MSWin32' || $^O eq 'VMS') { print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit; } @@ -34,7 +34,7 @@ EXPECT SIGINT handler "fred" not defined. ######## # mg.c -no warning 'signal' ; +no warnings 'signal' ; if ($^O eq 'MSWin32' || $^O eq 'VMS') { print "SKIPPED\n# win32, can't kill() to raise()\n"; exit; } diff --git a/t/pragma/warn/op b/t/pragma/warn/op index b5d2e71ebe..f6e5e14cad 100644 --- a/t/pragma/warn/op +++ b/t/pragma/warn/op @@ -59,7 +59,7 @@ local $a, $b = (1,2); Probable precedence problem on logical or at -e line 1. - use warning 'syntax'; my $x = print(ABC || 1); + use warnings 'syntax'; my $x = print(ABC || 1); Value of %s may be \"0\"; use \"defined\" $x = 1 if $x = <FH> ; @@ -112,16 +112,16 @@ __END__ # op.c -use warning 'unsafe' ; +use warnings 'unsafe' ; my $x ; my $x ; -no warning 'unsafe' ; +no warnings 'unsafe' ; my $x ; EXPECT "my" variable $x masks earlier declaration in same scope at - line 4. ######## # op.c -use warning 'unsafe' ; +use warnings 'unsafe' ; sub x { my $x; sub y { @@ -132,7 +132,7 @@ EXPECT Variable "$x" will not stay shared at - line 7. ######## # op.c -no warning 'unsafe' ; +no warnings 'unsafe' ; sub x { my $x; sub y { @@ -143,7 +143,7 @@ EXPECT ######## # op.c -use warning 'unsafe' ; +use warnings 'unsafe' ; sub x { my $x; sub y { @@ -154,7 +154,7 @@ EXPECT Variable "$x" may be unavailable at - line 6. ######## # op.c -no warning 'unsafe' ; +no warnings 'unsafe' ; sub x { my $x; sub y { @@ -165,31 +165,31 @@ EXPECT ######## # op.c -use warning 'syntax' ; +use warnings 'syntax' ; 1 if $a = 1 ; -no warning 'syntax' ; +no warnings 'syntax' ; 1 if $a = 1 ; EXPECT Found = in conditional, should be == at - line 3. ######## # op.c -use warning 'deprecated' ; +use warnings 'deprecated' ; split ; -no warning 'deprecated' ; +no warnings 'deprecated' ; split ; EXPECT Use of implicit split to @_ is deprecated at - line 3. ######## # op.c -use warning 'deprecated' ; +use warnings 'deprecated' ; $a = split ; -no warning 'deprecated' ; +no warnings 'deprecated' ; $a = split ; EXPECT Use of implicit split to @_ is deprecated at - line 3. ######## # op.c -use warning 'void' ; close STDIN ; +use warnings 'void' ; close STDIN ; 1 x 3 ; # OP_REPEAT # OP_GVSV wantarray ; # OP_WANTARRAY @@ -281,7 +281,7 @@ Useless use of getpwnam in void context at - line 52. Useless use of getpwuid in void context at - line 53. ######## # op.c -no warning 'void' ; close STDIN ; +no warnings 'void' ; close STDIN ; 1 x 3 ; # OP_REPEAT # OP_GVSV wantarray ; # OP_WANTARRAY @@ -336,15 +336,15 @@ eval { getpwuid 1 }; # OP_GPWUID EXPECT ######## # op.c -use warning 'void' ; +use warnings 'void' ; for (@{[0]}) { "$_" } # check warning isn't duplicated -no warning 'void' ; +no warnings 'void' ; for (@{[0]}) { "$_" } # check warning isn't duplicated EXPECT Useless use of string in void context at - line 3. ######## # op.c -use warning 'void' ; +use warnings 'void' ; use Config ; BEGIN { if ( ! $Config{d_telldir}) { @@ -356,13 +356,13 @@ EOM } } telldir 1 ; # OP_TELLDIR -no warning 'void' ; +no warnings 'void' ; telldir 1 ; # OP_TELLDIR EXPECT Useless use of telldir in void context at - line 13. ######## # op.c -use warning 'void' ; +use warnings 'void' ; use Config ; BEGIN { if ( ! $Config{d_getppid}) { @@ -374,13 +374,13 @@ EOM } } getppid ; # OP_GETPPID -no warning 'void' ; +no warnings 'void' ; getppid ; # OP_GETPPID EXPECT Useless use of getppid in void context at - line 13. ######## # op.c -use warning 'void' ; +use warnings 'void' ; use Config ; BEGIN { if ( ! $Config{d_getpgrp}) { @@ -392,13 +392,13 @@ EOM } } getpgrp ; # OP_GETPGRP -no warning 'void' ; +no warnings 'void' ; getpgrp ; # OP_GETPGRP EXPECT Useless use of getpgrp in void context at - line 13. ######## # op.c -use warning 'void' ; +use warnings 'void' ; use Config ; BEGIN { if ( ! $Config{d_times}) { @@ -410,13 +410,13 @@ EOM } } times ; # OP_TMS -no warning 'void' ; +no warnings 'void' ; times ; # OP_TMS EXPECT Useless use of times in void context at - line 13. ######## # op.c -use warning 'void' ; +use warnings 'void' ; use Config ; BEGIN { if ( ! $Config{d_getprior} or $^O eq 'os2') { # Locks before fixpak22 @@ -428,13 +428,13 @@ EOM } } getpriority 1,2; # OP_GETPRIORITY -no warning 'void' ; +no warnings 'void' ; getpriority 1,2; # OP_GETPRIORITY EXPECT Useless use of getpriority in void context at - line 13. ######## # op.c -use warning 'void' ; +use warnings 'void' ; use Config ; BEGIN { if ( ! $Config{d_getlogin}) { @@ -446,13 +446,13 @@ EOM } } getlogin ; # OP_GETLOGIN -no warning 'void' ; +no warnings 'void' ; getlogin ; # OP_GETLOGIN EXPECT Useless use of getlogin in void context at - line 13. ######## # op.c -use warning 'void' ; +use warnings 'void' ; use Config ; BEGIN { if ( ! $Config{d_socket}) { print <<EOM ; @@ -489,7 +489,7 @@ getservbyname 1,2; # OP_GSBYNAME getservbyport 1,2; # OP_GSBYPORT getservent ; # OP_GSERVENT -no warning 'void' ; +no warnings 'void' ; getsockname STDIN ; # OP_GETSOCKNAME getpeername STDIN ; # OP_GETPEERNAME gethostbyname 1 ; # OP_GHBYNAME @@ -525,12 +525,12 @@ Useless use of getservbyport in void context at - line 36. Useless use of getservent in void context at - line 37. ######## # op.c -use warning 'void' ; +use warnings 'void' ; *a ; # OP_RV2GV $a ; # OP_RV2SV @a ; # OP_RV2AV %a ; # OP_RV2HV -no warning 'void' ; +no warnings 'void' ; *a ; # OP_RV2GV $a ; # OP_RV2SV @a ; # OP_RV2AV @@ -542,10 +542,10 @@ Useless use of a variable in void context at - line 5. Useless use of a variable in void context at - line 6. ######## # op.c -use warning 'void' ; +use warnings 'void' ; "abc"; # OP_CONST 7 ; # OP_CONST -no warning 'void' ; +no warnings 'void' ; "abc"; # OP_CONST 7 ; # OP_CONST EXPECT @@ -554,7 +554,7 @@ Useless use of a constant in void context at - line 4. ######## # op.c $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; # known scalar leak -use warning 'unsafe' ; +use warnings 'unsafe' ; my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; @a =~ /abc/ ; @a =~ s/a/b/ ; @@ -569,7 +569,7 @@ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; %$c =~ s/a/b/ ; %$c =~ tr/a/b/ ; { -no warning 'unsafe' ; +no warnings 'unsafe' ; my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; @a =~ /abc/ ; @a =~ s/a/b/ ; @@ -601,25 +601,25 @@ Applying character translation to %hash will act on scalar(%hash) at - line 16. BEGIN not safe after errors--compilation aborted at - line 18. ######## # op.c -use warning 'syntax' ; +use warnings 'syntax' ; my $a, $b = (1,2); -no warning 'syntax' ; +no warnings 'syntax' ; my $c, $d = (1,2); EXPECT Parentheses missing around "my" list at - line 3. ######## # op.c -use warning 'syntax' ; +use warnings 'syntax' ; local $a, $b = (1,2); -no warning 'syntax' ; +no warnings 'syntax' ; local $c, $d = (1,2); EXPECT Parentheses missing around "local" list at - line 3. ######## # op.c -use warning 'syntax' ; +use warnings 'syntax' ; print (ABC || 1) ; -no warning 'syntax' ; +no warnings 'syntax' ; print (ABC || 1) ; EXPECT Probable precedence problem on logical or at - line 3. @@ -628,107 +628,107 @@ Probable precedence problem on logical or at - line 3. --FILE-- # op.c -use warning 'unsafe' ; +use warnings 'unsafe' ; open FH, "<abc" ; $x = 1 if $x = <FH> ; -no warning 'unsafe' ; +no warnings 'unsafe' ; $x = 1 if $x = <FH> ; EXPECT Value of <HANDLE> construct can be "0"; test with defined() at - line 4. ######## # op.c -use warning 'unsafe' ; +use warnings 'unsafe' ; opendir FH, "." ; $x = 1 if $x = readdir FH ; -no warning 'unsafe' ; +no warnings 'unsafe' ; $x = 1 if $x = readdir FH ; closedir FH ; EXPECT Value of readdir() operator can be "0"; test with defined() at - line 4. ######## # op.c -use warning 'unsafe' ; +use warnings 'unsafe' ; $x = 1 if $x = <*> ; -no warning 'unsafe' ; +no warnings 'unsafe' ; $x = 1 if $x = <*> ; EXPECT Value of glob construct can be "0"; test with defined() at - line 3. ######## # op.c -use warning 'unsafe' ; +use warnings 'unsafe' ; %a = (1,2,3,4) ; $x = 1 if $x = each %a ; -no warning 'unsafe' ; +no warnings 'unsafe' ; $x = 1 if $x = each %a ; EXPECT Value of each() operator can be "0"; test with defined() at - line 4. ######## # op.c -use warning 'unsafe' ; +use warnings 'unsafe' ; $x = 1 while $x = <*> and 0 ; -no warning 'unsafe' ; +no warnings 'unsafe' ; $x = 1 while $x = <*> and 0 ; EXPECT Value of glob construct can be "0"; test with defined() at - line 3. ######## # op.c -use warning 'unsafe' ; +use warnings 'unsafe' ; opendir FH, "." ; $x = 1 while $x = readdir FH and 0 ; -no warning 'unsafe' ; +no warnings 'unsafe' ; $x = 1 while $x = readdir FH and 0 ; closedir FH ; EXPECT Value of readdir() operator can be "0"; test with defined() at - line 4. ######## # op.c -use warning 'redefine' ; +use warnings 'redefine' ; sub fred {} sub fred {} -no warning 'redefine' ; +no warnings 'redefine' ; sub fred {} EXPECT Subroutine fred redefined at - line 4. ######## # op.c -use warning 'redefine' ; +use warnings 'redefine' ; sub fred () { 1 } sub fred () { 1 } -no warning 'redefine' ; +no warnings 'redefine' ; sub fred () { 1 } EXPECT Constant subroutine fred redefined at - line 4. ######## # op.c -use warning 'redefine' ; +use warnings 'redefine' ; format FRED = . format FRED = . -no warning 'redefine' ; +no warnings 'redefine' ; format FRED = . EXPECT Format FRED redefined at - line 5. ######## # op.c -use warning 'syntax' ; +use warnings 'syntax' ; push FRED; -no warning 'syntax' ; +no warnings 'syntax' ; push FRED; EXPECT Array @FRED missing the @ in argument 1 of push() at - line 3. ######## # op.c -use warning 'syntax' ; +use warnings 'syntax' ; @a = keys FRED ; -no warning 'syntax' ; +no warnings 'syntax' ; @a = keys FRED ; EXPECT Hash %FRED missing the % in argument 1 of keys() at - line 3. ######## # op.c -use warning 'syntax' ; +use warnings 'syntax' ; exec "$^X -e 1" ; my $a EXPECT @@ -736,28 +736,28 @@ Statement unlikely to be reached at - line 4. (Maybe you meant system() when you said exec()?) ######## # op.c -use warning 'deprecated' ; +use warnings 'deprecated' ; my @a; defined(@a); EXPECT defined(@array) is deprecated at - line 3. (Maybe you should just omit the defined()?) ######## # op.c -use warning 'deprecated' ; +use warnings 'deprecated' ; defined(@a = (1,2,3)); EXPECT defined(@array) is deprecated at - line 3. (Maybe you should just omit the defined()?) ######## # op.c -use warning 'deprecated' ; +use warnings 'deprecated' ; my %h; defined(%h); EXPECT defined(%hash) is deprecated at - line 3. (Maybe you should just omit the defined()?) ######## # op.c -no warning 'syntax' ; +no warnings 'syntax' ; exec "$^X -e 1" ; my $a EXPECT @@ -774,10 +774,10 @@ $^W = 0 ; sub fred() ; sub fred($) {} { - no warning 'unsafe' ; + no warnings 'unsafe' ; sub Fred() ; sub Fred($) {} - use warning 'unsafe' ; + use warnings 'unsafe' ; sub freD() ; sub freD($) {} } diff --git a/t/pragma/warn/perl b/t/pragma/warn/perl index 25f125e03d..45807499d6 100644 --- a/t/pragma/warn/perl +++ b/t/pragma/warn/perl @@ -16,9 +16,9 @@ __END__ # perl.c -no warning 'once' ; +no warnings 'once' ; $x = 3 ; -use warning 'once' ; +use warnings 'once' ; $z = 3 ; EXPECT Name "main::z" used only once: possible typo at - line 5. @@ -26,7 +26,7 @@ Name "main::z" used only once: possible typo at - line 5. -w # perl.c $x = 3 ; -no warning 'once' ; +no warnings 'once' ; $z = 3 EXPECT Name "main::x" used only once: possible typo at - line 3. @@ -34,16 +34,16 @@ Name "main::x" used only once: possible typo at - line 3. # perl.c BEGIN { $^W =1 ; } $x = 3 ; -no warning 'once' ; +no warnings 'once' ; $z = 3 EXPECT Name "main::x" used only once: possible typo at - line 3. ######## -W # perl.c -no warning 'once' ; +no warnings 'once' ; $x = 3 ; -use warning 'once' ; +use warnings 'once' ; $z = 3 ; EXPECT Name "main::x" used only once: possible typo at - line 4. @@ -51,7 +51,7 @@ Name "main::z" used only once: possible typo at - line 6. ######## -X # perl.c -use warning 'once' ; +use warnings 'once' ; $x = 3 ; EXPECT diff --git a/t/pragma/warn/perly b/t/pragma/warn/perly index bddc39c716..afc5dccc72 100644 --- a/t/pragma/warn/perly +++ b/t/pragma/warn/perly @@ -11,14 +11,14 @@ __END__ # perly.y -use warning 'deprecated' ; +use warnings 'deprecated' ; sub fred {} do fred() ; do fred(1) ; $a = "fred" ; do $a() ; do $a(1) ; -no warning 'deprecated' ; +no warnings 'deprecated' ; do fred() ; do fred(1) ; $a = "fred" ; diff --git a/t/pragma/warn/pp b/t/pragma/warn/pp index 9baf9c14b0..48b5ec86b5 100644 --- a/t/pragma/warn/pp +++ b/t/pragma/warn/pp @@ -34,44 +34,44 @@ __END__ # pp.c -use warning 'substr' ; +use warnings 'substr' ; $a = "ab" ; $a = substr($a, 4,5); -no warning 'substr' ; +no warnings 'substr' ; $a = "ab" ; $a = substr($a, 4,5); EXPECT substr outside of string at - line 4. ######## # pp.c -use warning 'substr' ; +use warnings 'substr' ; $a = "ab" ; $b = \$a ; substr($b, 1,1) = "ab" ; -no warning 'substr' ; +no warnings 'substr' ; substr($b, 1,1) = "ab" ; EXPECT Attempt to use reference as lvalue in substr at - line 5. ######## # pp.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; # TODO EXPECT ######## # pp.c -use warning 'unsafe' ; +use warnings 'unsafe' ; my $a = { 1,2,3}; -no warning 'unsafe' ; +no warnings 'unsafe' ; my $b = { 1,2,3}; EXPECT Odd number of elements in hash assignment at - line 3. ######## # pp.c -use warning 'unsafe' ; +use warnings 'unsafe' ; my @a = unpack ("A,A", "22") ; my $a = pack ("A,A", 1,2) ; -no warning 'unsafe' ; +no warnings 'unsafe' ; my @b = unpack ("A,A", "22") ; my $b = pack ("A,A", 1,2) ; EXPECT @@ -79,27 +79,27 @@ Invalid type in unpack: ',' at - line 3. Invalid type in pack: ',' at - line 4. ######## # pp.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; my $a = undef ; my $b = $$a; -no warning 'uninitialized' ; +no warnings 'uninitialized' ; my $c = $$a; EXPECT Use of uninitialized value at - line 4. ######## # pp.c -use warning 'unsafe' ; +use warnings 'unsafe' ; sub foo { my $a = "a"; return $a . $a++ . $a++ } my $a = pack("p", &foo) ; -no warning 'unsafe' ; +no warnings 'unsafe' ; my $b = pack("p", &foo) ; EXPECT Attempt to pack pointer to temporary value at - line 4. ######## # pp.c -use warning 'unsafe' ; +use warnings 'unsafe' ; bless \[], "" ; -no warning 'unsafe' ; +no warnings 'unsafe' ; bless \[], "" ; EXPECT Explicit blessing to '' (assuming package main) at - line 3. @@ -112,11 +112,11 @@ EXPECT Malformed UTF-8 character at - line 4. ######## # pp.c -use warning 'utf8' ; +use warnings 'utf8' ; use utf8 ; $_ = "\x80 \xff" ; reverse ; -no warning 'utf8' ; +no warnings 'utf8' ; $_ = "\x80 \xff" ; reverse ; EXPECT diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl index 4d6d8ca2af..5e0dd2766c 100644 --- a/t/pragma/warn/pp_ctl +++ b/t/pragma/warn/pp_ctl @@ -60,7 +60,7 @@ __END__ # pp_ctl.c -use warning 'syntax' ; +use warnings 'syntax' ; format STDOUT = @<<< @<<< 1 @@ -71,7 +71,7 @@ Not enough format arguments at - line 5. 1 ######## # pp_ctl.c -no warning 'syntax' ; +no warnings 'syntax' ; format = @<<< @<<< 1 @@ -81,14 +81,14 @@ EXPECT 1 ######## # pp_ctl.c -use warning 'unsafe' ; +use warnings 'unsafe' ; $_ = "abc" ; while ($i ++ == 0) { s/ab/last/e ; } -no warning 'unsafe' ; +no warnings 'unsafe' ; while ($i ++ == 0) { s/ab/last/e ; @@ -97,10 +97,10 @@ EXPECT Exiting substitution via last at - line 7. ######## # pp_ctl.c -use warning 'unsafe' ; +use warnings 'unsafe' ; sub fred { last } { fred() } -no warning 'unsafe' ; +no warnings 'unsafe' ; sub joe { last } { joe() } EXPECT @@ -108,35 +108,35 @@ Exiting subroutine via last at - line 3. ######## # pp_ctl.c { - eval "use warning 'unsafe' ; last;" + eval "use warnings 'unsafe' ; last;" } print STDERR $@ ; { - eval "no warning 'unsafe' ;last;" + eval "no warnings 'unsafe' ;last;" } print STDERR $@ ; EXPECT Exiting eval via last at (eval 1) line 1. ######## # pp_ctl.c -use warning 'unsafe' ; +use warnings 'unsafe' ; @a = (1,2) ; @b = sort { last } @a ; -no warning 'unsafe' ; +no warnings 'unsafe' ; @b = sort { last } @a ; EXPECT Exiting pseudo-block via last at - line 4. Can't "last" outside a block at - line 4. ######## # pp_ctl.c -use warning 'unsafe' ; +use warnings 'unsafe' ; $_ = "abc" ; fred: while ($i ++ == 0) { s/ab/last fred/e ; } -no warning 'unsafe' ; +no warnings 'unsafe' ; while ($i ++ == 0) { s/ab/last fred/e ; @@ -145,10 +145,10 @@ EXPECT Exiting substitution via last at - line 7. ######## # pp_ctl.c -use warning 'unsafe' ; +use warnings 'unsafe' ; sub fred { last joe } joe: { fred() } -no warning 'unsafe' ; +no warnings 'unsafe' ; sub Fred { last Joe } Joe: { Fred() } EXPECT @@ -156,26 +156,26 @@ Exiting subroutine via last at - line 3. ######## # pp_ctl.c joe: -{ eval "use warning 'unsafe' ; last joe;" } +{ eval "use warnings 'unsafe' ; last joe;" } print STDERR $@ ; Joe: -{ eval "no warning 'unsafe' ; last Joe;" } +{ eval "no warnings 'unsafe' ; last Joe;" } print STDERR $@ ; EXPECT Exiting eval via last at (eval 1) line 1. ######## # pp_ctl.c -use warning 'unsafe' ; +use warnings 'unsafe' ; @a = (1,2) ; fred: @b = sort { last fred } @a ; -no warning 'unsafe' ; +no warnings 'unsafe' ; Fred: @b = sort { last Fred } @a ; EXPECT Exiting pseudo-block via last at - line 4. Label not found for "last fred" at - line 4. ######## # pp_ctl.c -use warning 'recursion' ; +use warnings 'recursion' ; BEGIN { warn "PREFIX\n" ;} sub fred { @@ -187,7 +187,7 @@ EXPECT Deep recursion on subroutine "main::fred" at - line 6. ######## # pp_ctl.c -no warning 'recursion' ; +no warnings 'recursion' ; BEGIN { warn "PREFIX\n" ;} sub fred { @@ -199,7 +199,7 @@ EXPECT Can't find label ######## # pp_ctl.c -use warning 'unsafe' ; +use warnings 'unsafe' ; package Foo; DESTROY { die "@{$_[0]} foo bar" } { bless ['A'], 'Foo' for 1..10 } @@ -209,7 +209,7 @@ EXPECT (in cleanup) B foo bar at - line 4. ######## # pp_ctl.c -no warning 'unsafe' ; +no warnings 'unsafe' ; package Foo; DESTROY { die "@{$_[0]} foo bar" } { bless ['A'], 'Foo' for 1..10 } diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 208bf26b15..2a52dfb2df 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -35,16 +35,16 @@ __END__ # pp_hot.c -use warning 'unopened' ; +use warnings 'unopened' ; $f = $a = "abc" ; print $f $a; -no warning 'unopened' ; +no warnings 'unopened' ; print $f $a; EXPECT Filehandle main::abc never opened at - line 4. ######## # pp_hot.c -use warning 'io' ; +use warnings 'io' ; print STDIN "anc"; print <STDOUT>; print <STDERR>; @@ -52,7 +52,7 @@ open(FOO, ">&STDOUT") and print <FOO>; print getc(STDERR); print getc(FOO); read(FOO,$_,1); -no warning 'io' ; +no warnings 'io' ; print STDIN "anc"; #################################################################### # N O T E # @@ -70,58 +70,58 @@ Filehandle main::FOO opened only for output at - line 8. Filehandle main::FOO opened only for output at - line 9. ######## # pp_hot.c -use warning 'closed' ; +use warnings 'closed' ; close STDIN ; print STDIN "anc"; -no warning 'closed' ; +no warnings 'closed' ; print STDIN "anc"; EXPECT print on closed filehandle main::STDIN at - line 4. ######## # pp_hot.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; my $a = undef ; my @b = @$a; -no warning 'uninitialized' ; +no warnings 'uninitialized' ; my @c = @$a; EXPECT Use of uninitialized value at - line 4. ######## # pp_hot.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; my $a = undef ; my %b = %$a; -no warning 'uninitialized' ; +no warnings 'uninitialized' ; my %c = %$a; EXPECT Use of uninitialized value at - line 4. ######## # pp_hot.c -use warning 'unsafe' ; +use warnings 'unsafe' ; my %X ; %X = (1,2,3) ; -no warning 'unsafe' ; +no warnings 'unsafe' ; my %Y ; %Y = (1,2,3) ; EXPECT Odd number of elements in hash assignment at - line 3. ######## # pp_hot.c -use warning 'unsafe' ; +use warnings 'unsafe' ; my %X ; %X = [1 .. 3] ; -no warning 'unsafe' ; +no warnings 'unsafe' ; my %Y ; %Y = [1 .. 3] ; EXPECT Reference found where even-sized list expected at - line 3. ######## # pp_hot.c -use warning 'closed' ; +use warnings 'closed' ; close STDIN ; $a = <STDIN> ; -no warning 'closed' ; +no warnings 'closed' ; $a = <STDIN> ; EXPECT Read on closed filehandle main::STDIN at - line 3. ######## # pp_hot.c -use warning 'recursion' ; +use warnings 'recursion' ; sub fred { fred() if $a++ < 200 @@ -136,7 +136,7 @@ EXPECT ok ######## # pp_hot.c -no warning 'recursion' ; +no warnings 'recursion' ; sub fred { fred() if $a++ < 200 @@ -151,7 +151,7 @@ EXPECT ######## # pp_hot.c -use warning 'recursion' ; +use warnings 'recursion' ; $b = sub { &$b if $a++ < 200 @@ -162,7 +162,7 @@ EXPECT Deep recursion on anonymous subroutine at - line 5. ######## # pp_hot.c -no warning 'recursion' ; +no warnings 'recursion' ; $b = sub { &$b if $a++ < 200 diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys index bf64a940e1..d0caf96f34 100644 --- a/t/pragma/warn/pp_sys +++ b/t/pragma/warn/pp_sys @@ -78,39 +78,39 @@ __END__ # pp_sys.c -use warning 'untie' ; +use warnings 'untie' ; sub TIESCALAR { bless [] } ; $b = tie $a, 'main'; untie $a ; -no warning 'untie' ; +no warnings 'untie' ; $c = tie $d, 'main'; untie $d ; EXPECT untie attempted while 1 inner references still exist at - line 5. ######## # pp_sys.c -use warning 'io' ; +use warnings 'io' ; format STDIN = . write STDIN; -no warning 'io' ; +no warnings 'io' ; write STDIN; EXPECT Filehandle main::STDIN opened only for input at - line 5. ######## # pp_sys.c -use warning 'closed' ; +use warnings 'closed' ; format STDIN = . close STDIN; write STDIN; -no warning 'closed' ; +no warnings 'closed' ; write STDIN; EXPECT Write on closed filehandle main::STDIN at - line 6. ######## # pp_sys.c -use warning 'io' ; +use warnings 'io' ; format STDOUT_TOP = abc . @@ -122,48 +122,48 @@ $= = 1 ; $- =1 ; open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ; write ; -no warning 'io' ; +no warnings 'io' ; write ; EXPECT page overflow at - line 13. ######## # pp_sys.c -use warning 'unopened' ; +use warnings 'unopened' ; $a = "abc"; printf $a "fred"; -no warning 'unopened' ; +no warnings 'unopened' ; printf $a "fred"; EXPECT Filehandle main::abc never opened at - line 4. ######## # pp_sys.c -use warning 'closed' ; +use warnings 'closed' ; close STDIN ; printf STDIN "fred"; -no warning 'closed' ; +no warnings 'closed' ; printf STDIN "fred"; EXPECT printf on closed filehandle main::STDIN at - line 4. ######## # pp_sys.c -use warning 'io' ; +use warnings 'io' ; printf STDIN "fred"; -no warning 'io' ; +no warnings 'io' ; printf STDIN "fred"; EXPECT Filehandle main::STDIN opened only for input at - line 3. ######## # pp_sys.c -use warning 'closed' ; +use warnings 'closed' ; close STDIN; syswrite STDIN, "fred", 1; -no warning 'closed' ; +no warnings 'closed' ; syswrite STDIN, "fred", 1; EXPECT Syswrite on closed filehandle at - line 4. ######## # pp_sys.c -use warning 'io' ; +use warnings 'io' ; use Config; BEGIN { if ( $^O ne 'VMS' and ! $Config{d_socket}) { @@ -193,7 +193,7 @@ setsockopt STDIN, 1,2,3; getsockopt STDIN, 1,2; getsockname STDIN; getpeername STDIN; -no warning 'io' ; +no warnings 'io' ; send STDIN, "fred", 1; bind STDIN, "fred" ; connect STDIN, "fred" ; @@ -217,26 +217,26 @@ get{sock, peer}name() on closed fd at - line 30. get{sock, peer}name() on closed fd at - line 31. ######## # pp_sys.c -use warning 'newline' ; +use warnings 'newline' ; stat "abc\ndef"; -no warning 'newline' ; +no warnings 'newline' ; stat "abc\ndef"; EXPECT Unsuccessful stat on filename containing newline at - line 3. ######## # pp_sys.c -use warning 'unopened' ; +use warnings 'unopened' ; close STDIN ; -T STDIN ; -no warning 'unopened' ; +no warnings 'unopened' ; -T STDIN ; EXPECT Test on unopened file <STDIN> at - line 4. ######## # pp_sys.c -use warning 'newline' ; +use warnings 'newline' ; -T "abc\ndef" ; -no warning 'newline' ; +no warnings 'newline' ; -T "abc\ndef" ; EXPECT Unsuccessful open on filename containing newline at - line 3. diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp index 6545778a38..6aa9fa629e 100644 --- a/t/pragma/warn/regcomp +++ b/t/pragma/warn/regcomp @@ -13,25 +13,25 @@ __END__ # regcomp.c -use warning 'unsafe' ; +use warnings 'unsafe' ; my $a = "ABC123" ; $a =~ /(?=a)*/ ; -no warning 'unsafe' ; +no warnings 'unsafe' ; $a =~ /(?=a)*/ ; EXPECT (?=a)* matches null string many times at - line 4. ######## # regcomp.c -use warning 'unsafe' ; +use warnings 'unsafe' ; $_ = "" ; /(?=a)?/; -no warning 'unsafe' ; +no warnings 'unsafe' ; /(?=a)?/; EXPECT Strange *+?{} on zero-length expression at - line 4. ######## # regcomp.c -use warning 'unsafe' ; +use warnings 'unsafe' ; $_ = "" ; /[:alpha:]/; /[.bar.]/; @@ -40,7 +40,7 @@ $_ = "" ; /[[.foo.]]/; /[[=bar=]]/; /[:zog:]/; -no warning 'unsafe' ; +no warnings 'unsafe' ; /[:alpha:]/; /[.foo.]/; /[=bar=]/; diff --git a/t/pragma/warn/regexec b/t/pragma/warn/regexec index ce4eac7083..b9ba790832 100644 --- a/t/pragma/warn/regexec +++ b/t/pragma/warn/regexec @@ -16,7 +16,7 @@ __END__ # regexec.c print("SKIPPED\n# most systems run into stacksize limits\n"),exit; -use warning 'unsafe' ; +use warnings 'unsafe' ; $SIG{__WARN__} = sub{local ($m) = shift; $m =~ s/\(\d+\)/(*MASKED*)/; print STDERR $m}; @@ -42,7 +42,7 @@ Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9. ######## # regexec.c print("SKIPPED\n# most systems run into stacksize limits\n"),exit; -no warning 'unsafe' ; +no warnings 'unsafe' ; $SIG{__WARN__} = sub{local ($m) = shift; $m =~ s/\(\d+\)/(*MASKED*)/; print STDERR $m}; @@ -68,7 +68,7 @@ EXPECT ######## # regexec.c print("SKIPPED\n# most systems run into stacksize limits\n"),exit; -use warning 'unsafe' ; +use warnings 'unsafe' ; $SIG{__WARN__} = sub{local ($m) = shift; $m =~ s/\(\d+\)/(*MASKED*)/; print STDERR $m}; @@ -94,7 +94,7 @@ Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9. ######## # regexec.c print("SKIPPED\n# most systems run into stacksize limits\n"),exit; -no warning 'unsafe' ; +no warnings 'unsafe' ; $SIG{__WARN__} = sub{local ($m) = shift; $m =~ s/\(\d+\)/(*MASKED*)/; print STDERR $m}; diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv index b6c91c9fe9..a90e9d351d 100644 --- a/t/pragma/warn/sv +++ b/t/pragma/warn/sv @@ -49,9 +49,9 @@ __END__ # sv.c use integer ; -use warning 'uninitialized' ; +use warnings 'uninitialized' ; $x = 1 + $a[0] ; # a -no warning 'uninitialized' ; +no warnings 'uninitialized' ; $x = 1 + $b[0] ; # a EXPECT Use of uninitialized value at - line 4. @@ -64,18 +64,18 @@ sub STORE { return 1 } package main ; tie $A, 'fred' ; use integer ; -use warning 'uninitialized' ; +use warnings 'uninitialized' ; $A *= 2 ; -no warning 'uninitialized' ; +no warnings 'uninitialized' ; $A *= 2 ; EXPECT Use of uninitialized value at - line 10. ######## # sv.c use integer ; -use warning 'uninitialized' ; +use warnings 'uninitialized' ; my $x *= 2 ; #b -no warning 'uninitialized' ; +no warnings 'uninitialized' ; my $y *= 2 ; #b EXPECT Use of uninitialized value at - line 4. @@ -87,37 +87,37 @@ sub FETCH { return undef } sub STORE { return 1 } package main ; tie $A, 'fred' ; -use warning 'uninitialized' ; +use warnings 'uninitialized' ; $B = 0 ; $B |= $A ; -no warning 'uninitialized' ; +no warnings 'uninitialized' ; $B = 0 ; $B |= $A ; EXPECT Use of uninitialized value at - line 10. ######## # sv.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; my $Y = 1 ; my $x = 1 | $a[$Y] ; -no warning 'uninitialized' ; +no warnings 'uninitialized' ; my $Y = 1 ; $x = 1 | $b[$Y] ; EXPECT Use of uninitialized value at - line 4. ######## # sv.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; my $x *= 1 ; # d -no warning 'uninitialized' ; +no warnings 'uninitialized' ; my $y *= 1 ; # d EXPECT Use of uninitialized value at - line 3. ######## # sv.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; $x = 1 + $a[0] ; # e -no warning 'uninitialized' ; +no warnings 'uninitialized' ; $x = 1 + $b[0] ; # e EXPECT Use of uninitialized value at - line 3. @@ -129,33 +129,33 @@ sub FETCH { return undef } sub STORE { return 1 } package main ; tie $A, 'fred' ; -use warning 'uninitialized' ; +use warnings 'uninitialized' ; $A *= 2 ; -no warning 'uninitialized' ; +no warnings 'uninitialized' ; $A *= 2 ; EXPECT Use of uninitialized value at - line 9. ######## # sv.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; $x = $y + 1 ; # f -no warning 'uninitialized' ; +no warnings 'uninitialized' ; $x = $z + 1 ; # f EXPECT Use of uninitialized value at - line 3. ######## # sv.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; $x = chop undef ; # g -no warning 'uninitialized' ; +no warnings 'uninitialized' ; $x = chop undef ; # g EXPECT Modification of a read-only value attempted at - line 3. ######## # sv.c -use warning 'uninitialized' ; +use warnings 'uninitialized' ; $x = chop $y ; # h -no warning 'uninitialized' ; +no warnings 'uninitialized' ; $x = chop $z ; # h EXPECT Use of uninitialized value at - line 3. @@ -167,73 +167,73 @@ sub FETCH { return undef } sub STORE { return 1 } package main ; tie $A, 'fred' ; -use warning 'uninitialized' ; +use warnings 'uninitialized' ; $B = "" ; $B .= $A ; -no warning 'uninitialized' ; +no warnings 'uninitialized' ; $C = "" ; $C .= $A ; EXPECT Use of uninitialized value at - line 10. ######## # sv.c -use warning 'numeric' ; +use warnings 'numeric' ; sub TIESCALAR{bless[]} ; sub FETCH {"def"} ; tie $a,"main" ; my $b = 1 + $a; -no warning 'numeric' ; +no warnings 'numeric' ; my $c = 1 + $a; EXPECT Argument "def" isn't numeric in add at - line 6. ######## # sv.c -use warning 'numeric' ; +use warnings 'numeric' ; my $x = 1 + "def" ; -no warning 'numeric' ; +no warnings 'numeric' ; my $z = 1 + "def" ; EXPECT Argument "def" isn't numeric in add at - line 3. ######## # sv.c -use warning 'numeric' ; +use warnings 'numeric' ; my $a = "def" ; my $x = 1 + $a ; -no warning 'numeric' ; +no warnings 'numeric' ; my $y = 1 + $a ; EXPECT Argument "def" isn't numeric in add at - line 4. ######## # sv.c -use warning 'numeric' ; use integer ; +use warnings 'numeric' ; use integer ; my $a = "def" ; my $x = 1 + $a ; -no warning 'numeric' ; +no warnings 'numeric' ; my $z = 1 + $a ; EXPECT Argument "def" isn't numeric in i_add at - line 4. ######## # sv.c -use warning 'numeric' ; +use warnings 'numeric' ; my $x = 1 & "def" ; -no warning 'numeric' ; +no warnings 'numeric' ; my $z = 1 & "def" ; EXPECT Argument "def" isn't numeric in bit_and at - line 3. ######## # sv.c -use warning 'redefine' ; +use warnings 'redefine' ; sub fred {} sub joe {} *fred = \&joe ; -no warning 'redefine' ; +no warnings 'redefine' ; sub jim {} *jim = \&joe ; EXPECT Subroutine fred redefined at - line 5. ######## # sv.c -use warning 'printf' ; +use warnings 'printf' ; open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ; printf F "%z\n" ; my $a = sprintf "%z" ; @@ -241,7 +241,7 @@ printf F "%" ; $a = sprintf "%" ; printf F "%\x02" ; $a = sprintf "%\x02" ; -no warning 'printf' ; +no warnings 'printf' ; printf F "%z\n" ; $a = sprintf "%z" ; printf F "%" ; @@ -257,9 +257,9 @@ Invalid conversion in printf: end of string at - line 6. Invalid conversion in printf: "%\002" at - line 8. ######## # sv.c -use warning 'unsafe' ; +use warnings 'unsafe' ; *a = undef ; -no warning 'unsafe' ; +no warnings 'unsafe' ; *b = undef ; EXPECT Undefined value assigned to typeglob at - line 3. @@ -268,9 +268,9 @@ Undefined value assigned to typeglob at - line 3. use utf8 ; $^W =0 ; { - use warning 'utf8' ; + use warnings 'utf8' ; my $a = rindex "a\xff bc ", "bc" ; - no warning 'utf8' ; + no warnings 'utf8' ; $a = rindex "a\xff bc ", "bc" ; } my $a = rindex "a\xff bc ", "bc" ; diff --git a/t/pragma/warn/taint b/t/pragma/warn/taint index 17ab0423c6..fd6deed60f 100644 --- a/t/pragma/warn/taint +++ b/t/pragma/warn/taint @@ -37,10 +37,10 @@ def open(FH, "<abc") ; $a = <FH> ; close FH ; -use warning 'taint' ; +use warnings 'taint' ; chdir $a ; print "xxx\n" ; -no warning 'taint' ; +no warnings 'taint' ; chdir $a ; print "yyy\n" ; EXPECT diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke index 72c1e2fddc..661d3d40b2 100644 --- a/t/pragma/warn/toke +++ b/t/pragma/warn/toke @@ -14,7 +14,7 @@ toke.c AOK (called 3 times via depcom) \1 better written as $1 - use warning 'syntax' ; + use warnings 'syntax' ; s/(abc)/\1/; warn(warn_nosemi) @@ -114,14 +114,14 @@ toke.c AOK __END__ # toke.c -use warning 'deprecated' ; +use warnings 'deprecated' ; 1 if $a EQ $b ; 1 if $a NE $b ; 1 if $a GT $b ; 1 if $a LT $b ; 1 if $a GE $b ; 1 if $a LE $b ; -no warning 'deprecated' ; +no warnings 'deprecated' ; 1 if $a EQ $b ; 1 if $a NE $b ; 1 if $a GT $b ; @@ -137,12 +137,12 @@ Use of GE is deprecated at - line 7. Use of LE is deprecated at - line 8. ######## # toke.c -use warning 'deprecated' ; +use warnings 'deprecated' ; format STDOUT = @<<< @||| @>>> @>>> $a $b "abc" 'def' . -no warning 'deprecated' ; +no warnings 'deprecated' ; format STDOUT = @<<< @||| @>>> @>>> $a $b "abc" 'def' @@ -153,28 +153,28 @@ Use of comma-less variable list is deprecated at - line 5. Use of comma-less variable list is deprecated at - line 5. ######## # toke.c -use warning 'deprecated' ; +use warnings 'deprecated' ; $a = <<; -no warning 'deprecated' ; +no warnings 'deprecated' ; $a = <<; EXPECT Use of bare << to mean <<"" is deprecated at - line 3. ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; s/(abc)/\1/; -no warning 'syntax' ; +no warnings 'syntax' ; s/(abc)/\1/; EXPECT \1 better written as $1 at - line 3. ######## # toke.c -use warning 'semicolon' ; +use warnings 'semicolon' ; $a = 1 &time ; -no warning 'semicolon' ; +no warnings 'semicolon' ; $a = 1 &time ; EXPECT @@ -185,7 +185,7 @@ BEGIN { # Scalars leaked: due to syntax errors $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; } -use warning 'syntax' ; +use warnings 'syntax' ; my $a =+ 2 ; $a =- 2 ; $a =* 2 ; @@ -216,7 +216,7 @@ BEGIN { # Scalars leaked: due to syntax errors $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; } -no warning 'syntax' ; +no warnings 'syntax' ; my $a =+ 2 ; $a =- 2 ; $a =* 2 ; @@ -234,26 +234,26 @@ syntax error at - line 14, near "=|" Unterminated <> operator at - line 15. ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; my $a = $a[1,2] ; -no warning 'syntax' ; +no warnings 'syntax' ; my $a = $a[1,2] ; EXPECT Multidimensional syntax $a[1,2] not supported at - line 3. ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; sub fred {} ; $SIG{TERM} = fred; -no warning 'syntax' ; +no warnings 'syntax' ; $SIG{TERM} = fred; EXPECT You need to quote "fred" at - line 3. ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; @a[3] = 2; @a{3} = 2; -no warning 'syntax' ; +no warnings 'syntax' ; @a[3] = 2; @a{3} = 2; EXPECT @@ -261,133 +261,133 @@ Scalar value @a[3] better written as $a[3] at - line 3. Scalar value @a{3} better written as $a{3} at - line 4. ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; $_ = "ab" ; s/(ab)/\1/e; -no warning 'syntax' ; +no warnings 'syntax' ; $_ = "ab" ; s/(ab)/\1/e; EXPECT Can't use \1 to mean $1 in expression at - line 4. ######## # toke.c -use warning 'reserved' ; +use warnings 'reserved' ; $a = abc; -no warning 'reserved' ; +no warnings 'reserved' ; $a = abc; EXPECT Unquoted string "abc" may clash with future reserved word at - line 3. ######## # toke.c -use warning 'octal' ; +use warnings 'octal' ; chmod 3; -no warning 'octal' ; +no warnings 'octal' ; chmod 3; EXPECT -chmod: mode argument is missing initial 0 at - line 3, at end of line +chmod: mode argument is missing initial 0 at - line 3. ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; @a = qw(a, b, c) ; -no warning 'syntax' ; +no warnings 'syntax' ; @a = qw(a, b, c) ; EXPECT Possible attempt to separate words with commas at - line 3. ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; @a = qw(a b #) ; -no warning 'syntax' ; +no warnings 'syntax' ; @a = qw(a b #) ; EXPECT Possible attempt to put comments in qw() list at - line 3. ######## # toke.c -use warning 'octal' ; +use warnings 'octal' ; umask 3; -no warning 'octal' ; +no warnings 'octal' ; umask 3; EXPECT -umask: argument is missing initial 0 at - line 3, at end of line +umask: argument is missing initial 0 at - line 3. ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; print ("") EXPECT print (...) interpreted as function at - line 3. ######## # toke.c -no warning 'syntax' ; +no warnings 'syntax' ; print ("") EXPECT ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; printf ("") EXPECT printf (...) interpreted as function at - line 3. ######## # toke.c -no warning 'syntax' ; +no warnings 'syntax' ; printf ("") EXPECT ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; sort ("") EXPECT sort (...) interpreted as function at - line 3. ######## # toke.c -no warning 'syntax' ; +no warnings 'syntax' ; sort ("") EXPECT ######## # toke.c -use warning 'ambiguous' ; +use warnings 'ambiguous' ; $a = ${time[2]}; -no warning 'ambiguous' ; +no warnings 'ambiguous' ; $a = ${time[2]}; EXPECT Ambiguous use of ${time[...]} resolved to $time[...] at - line 3. ######## # toke.c -use warning 'ambiguous' ; +use warnings 'ambiguous' ; $a = ${time{2}}; EXPECT Ambiguous use of ${time{...}} resolved to $time{...} at - line 3. ######## # toke.c -no warning 'ambiguous' ; +no warnings 'ambiguous' ; $a = ${time{2}}; EXPECT ######## # toke.c -use warning 'ambiguous' ; +use warnings 'ambiguous' ; $a = ${time} ; -no warning 'ambiguous' ; +no warnings 'ambiguous' ; $a = ${time} ; EXPECT Ambiguous use of ${time} resolved to $time at - line 3. ######## # toke.c -use warning 'ambiguous' ; +use warnings 'ambiguous' ; sub fred {} $a = ${fred} ; -no warning 'ambiguous' ; +no warnings 'ambiguous' ; $a = ${fred} ; EXPECT Ambiguous use of ${fred} resolved to $fred at - line 4. ######## # toke.c -use warning 'syntax' ; +use warnings 'syntax' ; $a = 1_2; $a = 1_2345_6; -no warning 'syntax' ; +no warnings 'syntax' ; $a = 1_2; $a = 1_2345_6; EXPECT @@ -396,26 +396,26 @@ Misplaced _ in number at - line 4. Misplaced _ in number at - line 4. ######## # toke.c -use warning 'unsafe' ; +use warnings 'unsafe' ; #line 25 "bar" $a = FRED:: ; -no warning 'unsafe' ; +no warnings 'unsafe' ; #line 25 "bar" $a = FRED:: ; EXPECT Bareword "FRED::" refers to nonexistent package at bar line 25. ######## # toke.c -use warning 'ambiguous' ; +use warnings 'ambiguous' ; sub time {} my $a = time() ; -no warning 'ambiguous' ; +no warnings 'ambiguous' ; my $b = time() ; EXPECT Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4. ######## # toke.c -use warning 'utf8' ; +use warnings 'utf8' ; eval <<'EOE'; { #line 30 "foo" @@ -426,7 +426,7 @@ EXPECT Use of \x{} without utf8 declaration at foo line 30. ######## # toke.c -no warning 'utf8' ; +no warnings 'utf8' ; eval <<'EOE'; { #line 30 "foo" @@ -437,10 +437,10 @@ EXPECT ######## # toke.c -use warning 'utf8' ; +use warnings 'utf8' ; use utf8 ; $_ = " \xffe " ; -no warning 'utf8' ; +no warnings 'utf8' ; $_ = " \xffe " ; EXPECT \xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4. @@ -454,9 +454,9 @@ Warning: Use of "rand" without parens is ambiguous at - line 2. $^W = 0 ; my $a = rand + 4 ; { - no warning 'ambiguous' ; + no warnings 'ambiguous' ; $a = rand + 4 ; - use warning 'ambiguous' ; + use warnings 'ambiguous' ; $a = rand + 4 ; } $a = rand + 4 ; @@ -476,9 +476,9 @@ $^W = 0 ; sub fred {} ; -fred ; { - no warning 'ambiguous' ; + no warnings 'ambiguous' ; -fred ; - use warning 'ambiguous' ; + use warnings 'ambiguous' ; -fred ; } -fred ; @@ -496,9 +496,9 @@ Precedence problem: open FOO should be open(FOO) at - line 2. $^W = 0 ; open FOO || time; { - no warning 'ambiguous' ; + no warnings 'ambiguous' ; open FOO || time; - use warning 'ambiguous' ; + use warnings 'ambiguous' ; open FOO || time; } open FOO || time; @@ -511,9 +511,9 @@ Precedence problem: open FOO should be open(FOO) at - line 10. $^W = 0 ; *foo *foo ; { - no warning 'ambiguous' ; + no warnings 'ambiguous' ; *foo *foo ; - use warning 'ambiguous' ; + use warnings 'ambiguous' ; *foo *foo ; } *foo *foo ; diff --git a/t/pragma/warn/universal b/t/pragma/warn/universal index 37e77195ca..f4f863701c 100644 --- a/t/pragma/warn/universal +++ b/t/pragma/warn/universal @@ -5,7 +5,7 @@ __END__ # universal.c -use warning 'misc' ; +use warnings 'misc' ; EXPECT diff --git a/t/pragma/warn/utf8 b/t/pragma/warn/utf8 index 380d53bbcc..30f552a231 100644 --- a/t/pragma/warn/utf8 +++ b/t/pragma/warn/utf8 @@ -25,9 +25,9 @@ Malformed UTF-8 character at - line 3. use utf8 ; my $a = ord "\x80" ; { - use warning 'utf8' ; + use warnings 'utf8' ; my $a = ord "\x80" ; - no warning 'utf8' ; + no warnings 'utf8' ; my $a = ord "\x80" ; } EXPECT @@ -45,9 +45,9 @@ Malformed UTF-8 character at - line 3. use utf8 ; my $a = ord "\xf080" ; { - use warning 'utf8' ; + use warnings 'utf8' ; my $a = ord "\xf080" ; - no warning 'utf8' ; + no warnings 'utf8' ; my $a = ord "\xf080" ; } EXPECT diff --git a/t/pragma/warn/util b/t/pragma/warn/util index eebd9207e4..e9093c4814 100644 --- a/t/pragma/warn/util +++ b/t/pragma/warn/util @@ -11,25 +11,25 @@ __END__ # util.c -use warning 'digit' ; +use warnings 'digit' ; my $a = oct "029" ; -no warning 'digit' ; +no warnings 'digit' ; my $a = oct "029" ; EXPECT Illegal octal digit '9' ignored at - line 3. ######## # util.c -use warning 'digit' ; +use warnings 'digit' ; *a = hex "0xv9" ; -no warning 'digit' ; +no warnings 'digit' ; *a = hex "0xv9" ; EXPECT Illegal hexadecimal digit 'v' ignored at - line 3. ######## # util.c -use warning 'digit' ; +use warnings 'digit' ; *a = oct "0b9" ; -no warning 'digit' ; +no warnings 'digit' ; *a = oct "0b9" ; EXPECT Illegal binary digit '9' ignored at - line 3. diff --git a/t/pragma/warning.t b/t/pragma/warnings.t index 73e4c8d1a8..73e4c8d1a8 100755..100644 --- a/t/pragma/warning.t +++ b/t/pragma/warnings.t @@ -3728,7 +3728,8 @@ Perl_yylex(pTHX) if (ckWARN(WARN_OCTAL)) { for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ; if (*d != '0' && isDIGIT(*d)) - yywarn("chmod: mode argument is missing initial 0"); + Perl_warner(aTHX_ WARN_OCTAL, + "chmod: mode argument is missing initial 0"); } LOP(OP_CHMOD,XTERM); @@ -4543,8 +4544,9 @@ Perl_yylex(pTHX) case KEY_umask: if (ckWARN(WARN_OCTAL)) { for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ; - if (*d != '0' && isDIGIT(*d)) - yywarn("umask: argument is missing initial 0"); + if (*d != '0' && isDIGIT(*d)) + Perl_warner(aTHX_ WARN_OCTAL, + "umask: argument is missing initial 0"); } UNI(OP_UMASK); diff --git a/warning.h b/warnings.h index 7395a96abe..a5d50bf859 100644 --- a/warning.h +++ b/warnings.h @@ -1,5 +1,5 @@ /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by warning.pl + This file is built by warnings.pl Any changes made here will be lost! */ @@ -17,8 +17,8 @@ #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) #define WARN_STD Nullsv -#define WARN_ALL (&PL_sv_yes) /* use warning 'all' */ -#define WARN_NONE (&PL_sv_no) /* no warning 'all' */ +#define WARN_ALL (&PL_sv_yes) /* use warnings 'all' */ +#define WARN_NONE (&PL_sv_no) /* no warnings 'all' */ #define specialWARN(x) ((x) == WARN_STD || (x) == WARN_ALL || \ (x) == WARN_NONE) @@ -102,5 +102,5 @@ #define WARN_ALLstring "\125\125\125\125\125\125\125\125\125" #define WARN_NONEstring "\0\0\0\0\0\0\0\0\0" -/* end of file warning.h */ +/* end of file warnings.h */ diff --git a/warning.pl b/warnings.pl index 593b5d7e7c..9ff4197612 100644 --- a/warning.pl +++ b/warnings.pl @@ -125,14 +125,14 @@ sub mkHex ########################################################################### -#unlink "warning.h"; -#unlink "lib/warning.pm"; -open(WARN, ">warning.h") || die "Can't create warning.h: $!\n"; -open(PM, ">lib/warning.pm") || die "Can't create lib/warning.pm: $!\n"; +#unlink "warnings.h"; +#unlink "lib/warnings.pm"; +open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n"; +open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n"; print WARN <<'EOM' ; /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by warning.pl + This file is built by warnings.pl Any changes made here will be lost! */ @@ -150,8 +150,8 @@ print WARN <<'EOM' ; #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) #define WARN_STD Nullsv -#define WARN_ALL (&PL_sv_yes) /* use warning 'all' */ -#define WARN_NONE (&PL_sv_no) /* no warning 'all' */ +#define WARN_ALL (&PL_sv_yes) /* use warnings 'all' */ +#define WARN_NONE (&PL_sv_no) /* no warnings 'all' */ #define specialWARN(x) ((x) == WARN_STD || (x) == WARN_ALL || \ (x) == WARN_NONE) @@ -216,7 +216,7 @@ print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" print WARN <<'EOM'; -/* end of file warning.h */ +/* end of file warnings.h */ EOM @@ -263,23 +263,23 @@ close PM ; __END__ -# This file was created by warning.pl +# This file was created by warnings.pl # Any changes made here will be lost. # -package warning; +package warnings; =head1 NAME -warning - Perl pragma to control optional warnings +warnings - Perl pragma to control optional warnings =head1 SYNOPSIS - use warning; - no warning; + use warnings; + no warnings; - use warning "all"; - no warning "all"; + use warnings "all"; + no warnings "all"; =head1 DESCRIPTION @@ -315,30 +315,12 @@ sub bits { sub import { shift; - $^B |= bits(@_ ? @_ : 'all') ; + ${^Warnings} |= bits(@_ ? @_ : 'all') ; } sub unimport { shift; - $^B &= ~ bits(@_ ? @_ : 'all') ; -} - - -sub make_fatal -{ - my $self = shift ; - my $bitmask = $self->bits(@_) ; - $SIG{__WARN__} = - sub - { - die @_ if $^B & $bitmask ; - warn @_ - } ; -} - -sub bitmask -{ - return $^B ; + ${^Warnings} &= ~ bits(@_ ? @_ : 'all') ; } sub enabled @@ -346,7 +328,7 @@ sub enabled my $string = shift ; return 1 - if $bits{$string} && $^B & $bits{$string} ; + if $bits{$string} && ${^Warnings} & $bits{$string} ; return 0 ; } |