# New Ticket Created by Animator
# Please include the string: [perl #36781]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/rt3/Ticket/Display.html?id=36781 >
This is a bug report for perl from [EMAIL PROTECTED],
generated with the help of perlbug 1.35 running under perl v5.8.5.
-----------------------------------------------------------------
[Please enter your report here]
Hello,
Several functions that are part of the warning pragma are buggy.
One of them is warnings::enabled. This functions takes a category and
reports whether or not warnings for that particular category are enabled
or disabled.
What goes wrong is that it checks if the warning was enabled at the
start of the block, in which the warnings::enabled call is. A
consequence of that is that warnings::enabled gives an incorrect return
value when a warning is enabled/disabled in that same block.
Code::
#!/usr/bin/perl
sub sub1 {
sub2();
}
sub sub2 {
use warnings qw/void/;
print warnings::enabled('void');
}
sub1();
Output:
This outputs 0, even though the warning is enabled.
Cause:
The reason why it outputs 0 and not 1 is because the warnings::enabled
checks in what context sub2 is called. sub1 called it, so it uses that
context, using the caller function, and at the moment sub2 was called,
the void-warnings were disabled.
The function that is responsible for that is the __chk function in
warnings.pl/pm.
If I understand the code of this function correctly then it does a trace
and stops at the first function that isn't part of the warnings package.
In the example above it stops at main::sub2. Then it checks the context
of that call, using the built-in caller function, which means it is
actually checking if a warning was enabled in sub1.
Below you find two patches, one for warnings.pl and one for warnings.pm.
The second is only included for the people that are unable to run the
warnings.pl script to re-create the warnings.h and warnings.pm file.
--- old/warnings.pl Fri Jul 29 23:13:36 2005
+++ new/warnings.pl Fri Jul 29 23:14:47 2005
@@ -752,7 +752,7 @@
if !$pkg || $pkg eq $this_pkg ;
}
- my $callers_bitmask = (caller($i))[9] ;
+ my $callers_bitmask = (caller($i - 1))[9] ;
return ($callers_bitmask, $offset, $i) ;
}
--- old/lib/warnings.pm Fri Jul 29 23:13:09 2005
+++ new/lib/warnings.pm Fri Jul 29 23:12:54 2005
@@ -440,7 +440,7 @@
if !$pkg || $pkg eq $this_pkg ;
}
- my $callers_bitmask = (caller($i))[9] ;
+ my $callers_bitmask = (caller($i - 1))[9] ;
return ($callers_bitmask, $offset, $i) ;
}
A simple test:
#!perl
use Test;
BEGIN { plan tests => 3 }
sub warnings_test {
use warnings;
my $code = sub {
no warnings qw/void/;
ok(warnings::enabled('all') == 0);
ok(warnings::enabled('misc') == 1);
ok(warnings::enabled('void') == 0);
};
$code->();
}
warnings_test();
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=low
---
Site configuration information for perl v5.8.5:
Configured by dennis at Wed Aug 18 16:09:43 CEST 2004.
Summary of my perl5 (revision 5 version 8 subversion 5) configuration:
Platform:
osname=freebsd, osvers=4.10-stable, archname=i386-freebsd
uname='freebsd raiden 4.10-stable freebsd 4.10-stable #0: wed aug 18
13:45:50 cest 2004 [EMAIL PROTECTED]:usrobjusrsrcsysraiden i386 '
config_args='-de'
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef use5005threads=undef useithreads=undef
usemultiplicity=undef
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H
-fno-strict-aliasing -pipe -I/usr/local/include',
optimize='-O',
cppflags='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing
-pipe -I/usr/local/include'
ccversion='', gccversion='2.95.4 20020320 [FreeBSD]',
gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags ='-Wl,-E -L/usr/local/lib'
libpth=/usr/lib /usr/local/lib
libs=-lm -lcrypt -lutil -lc
perllibs=-lm -lcrypt -lutil -lc
libc=, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
cccdlflags='-DPIC -fPIC', lddlflags='-shared -L/usr/local/lib'
Locally applied patches:
---
@INC for perl v5.8.5:
/usr/local/lib/perl5/5.8.5/i386-freebsd
/usr/local/lib/perl5/5.8.5
/usr/local/lib/perl5/site_perl/5.8.5/i386-freebsd
/usr/local/lib/perl5/site_perl/5.8.5
/usr/local/lib/perl5/site_perl
.
---
Environment for perl v5.8.5:
HOME=/home/animator
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/sbin:/bin:/usr/sbin:/usr/bin:/usr/games:/usr/local/sbin:/usr/local/bin:/usr/X11R6/bin:/home/animator/bin
PERL_BADLANG (unset)
SHELL=/usr/local/bin/bash
