Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

warnings::warn($obj,...) fails when $obj overloads "" #7522

Closed
p5pRT opened this issue Oct 5, 2004 · 4 comments
Closed

warnings::warn($obj,...) fails when $obj overloads "" #7522

p5pRT opened this issue Oct 5, 2004 · 4 comments

Comments

@p5pRT
Copy link

p5pRT commented Oct 5, 2004

Migrated from rt.perl.org#31843 (status was 'resolved')

Searchable as RT31843$

@p5pRT
Copy link
Author

p5pRT commented Oct 5, 2004

From kaminsky@math.huji.ac.il

Created by kaminsky@math.huji.ac.il

Whan using the syntax

warnings​::warn($obj, $msg)

Where $obj is an object with overloaded stringification, the call
fails. The reason is that the default stringification is assumed
for the purpose of determining the class name of the object. I
attach an example, and a patch which fixes it (I think).

Thanks,
Moshe

PS​: It might be useful to include in the docs of this module that
warnings​::warn already uses Carp, so that people don't go doing
warnings​::warn(Carp​::shortmess($msg)) and the like, as I did.

The example​:

#!/usr/bin/perl
package Foo;
use overload '""' => sub { 'foo' };
use warnings​::register;

sub new {
  my $self = bless {} => shift;
  warnings​::warn($self, 'This will never be shown!');
}

package main;

new Foo;

##### End of example ######

The patch, against warnings.pl (but can also be applied to warnings.pm)

Inline Patch
--- warnings.pl.old	2004-10-05 10:10:42.104221096 +0200
+++ warnings.pl	2004-10-05 10:23:29.910496800 +0200
@@ -708,6 +708,10 @@
     ${^WARNING_BITS} = $mask ;
 }
 
+{
+
+my %builtin_type = map { $_ => 1 } qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE);
+
 sub __chk
 {
     my $category ;
@@ -717,10 +721,10 @@
     if (@_) {
         # check the category supplied.
         $category = shift ;
-        if (ref $category) {
+        if (my $type = ref $category) {
             Croaker ("not an object")
-                if $category !~ /^([^=]+)=/ ;
-	    $category = $1 ;
+                if $builtin_type{$type};
+	    $category = $type;
             $isobj = 1 ;
         }
         $offset = $Offsets{$category};
@@ -755,6 +759,7 @@
     my $callers_bitmask = (caller($i))[9] ;
     return ($callers_bitmask, $offset, $i) ;
 }
+}
 
 sub enabled
 {
Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl v5.8.5:

Configured by Gentoo at Sat Aug 28 23:04:54 IDT 2004.

Summary of my perl5 (revision 5 version 8 subversion 5) configuration:
  Platform:
    osname=linux, osvers=2.6.8-gentoo-r3, archname=i686-linux-thread-multi
    uname='linux kaminsky 2.6.8-gentoo-r3 #1 fri aug 27 01:31:55 idt 2004 i686 amd duron(tm) processor authenticamd gnulinux '
    config_args='-des -Darchname=i686-linux-thread -Dcccdlflags=-fPIC -Dccdlflags=-rdynamic -Dcc=gcc -Dprefix=/usr -Dvendorprefix=/usr -Dsiteprefix=/usr -Dlocincpth=  -Doptimize=-O2 -march=athlon-tbird -pipe -fomit-frame-pointer -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Dscriptdir=/usr/bin -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dinstallman1dir=/usr/share/man/man1 -Dinstallman3dir=/usr/tmp/portage/perl-5.8.5/image//usr/share/man/man3 -Dman1ext=1 -Dman3ext=3pm -Dcf_by=Gentoo -Ud_csh -Dusethreads -Di_ndbm -Di_gdbm -Di_db'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -fno-strict-aliasing -pipe -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -march=athlon-tbird -pipe -fomit-frame-pointer',
    cppflags='-DPERL5 -D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -fno-strict-aliasing -pipe'
    ccversion='', gccversion='3.3.4 20040623 (Gentoo Linux 3.3.4-r1, ssp-3.3.2-2, pie-8.7.6)', 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='gcc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lpthread -lnsl -lndbm -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=/lib/libc-2.3.4.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.3.4'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.5:
    /etc/perl
    /usr/lib/perl5/site_perl/5.8.5/i686-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.5
    /usr/lib/perl5/site_perl/5.8.4/i686-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.4
    /usr/lib/perl5/site_perl/5.8.3/i686-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.3
    /usr/lib/perl5/site_perl
    /usr/lib/perl5/vendor_perl/5.8.5/i686-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.8.5
    /usr/lib/perl5/vendor_perl/5.8.4/i686-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.8.4
    /usr/lib/perl5/vendor_perl/5.8.3/i686-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.8.3
    /usr/lib/perl5/vendor_perl
    /usr/lib/perl5/5.8.5/i686-linux-thread-multi
    /usr/lib/perl5/5.8.5
    /usr/local/lib/site_perl
    /usr/lib/perl5/site_perl/5.8.4/i686-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.4
    /usr/lib/perl5/site_perl/5.8.3/i686-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.3
    .


Environment for perl v5.8.5:
    HOME=/home/moshe
    LANG=he_IL.utf8
    LANGUAGE (unset)
    LC_MESSAGES=POSIX
    LC_TIME=POSIX
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/moshe/bin:/usr/local/bin:/bin:/usr/bin:/opt/bin:/usr/i686-pc-linux-gnu/gcc-bin/3.4:/usr/X11R6/bin:/opt/blackdown-jdk-1.4.2_rc1/bin:/opt/blackdown-jdk-1.4.2_rc1/jre/bin:/usr/qt/3/bin:/usr/kde/3.3/bin:/usr/kde/3.2/bin:/usr/qt/2/bin:/usr/games/bin
    PERL_BADLANG (unset)
    SHELL=/bin/zsh

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2004

From @rgs

kaminsky (via RT) wrote​:

Whan using the syntax

warnings​::warn($obj, $msg)

Where $obj is an object with overloaded stringification, the call
fails. The reason is that the default stringification is assumed
for the purpose of determining the class name of the object. I
attach an example, and a patch which fixes it (I think).

Thanks, applied as change #23361 to bleadperl, with a few tweaks.

The patch, against warnings.pl (but can also be applied to warnings.pm)

--- warnings.pl.old 2004-10-05 10​:10​:42.104221096 +0200
+++ warnings.pl 2004-10-05 10​:23​:29.910496800 +0200
@​@​ -708,6 +708,10 @​@​
${^WARNING_BITS} = $mask ;
}

+{
+
+my %builtin_type = map { $_ => 1 } qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE);

Notably you forgot "Regexp" in the list above.

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2004

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2004

@rgs - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant