develooper Front page | perl.perl5.porters | Postings from December 2007

[perl #48355] Handling of RAWDATA broken badly in Attribute::Handlers in perl 5.10.0 RC2

From:
Sascha Blank
Date:
December 8, 2007 04:46
Subject:
[perl #48355] Handling of RAWDATA broken badly in Attribute::Handlers in perl 5.10.0 RC2
Message ID:
rt-3.6.HEAD-28750-1197114466-1411.48355-75-0@perl.org
# New Ticket Created by  Sascha Blank 
# Please include the string:  [perl #48355]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=48355 >


This is a bug report for perl from blank.sascha@googlemail.com,
generated with the help of perlbug 1.36 running under perl 5.10.0.


-----------------------------------------------------------------
[Please enter your report here]

Hello,

my error report is about this particular change:

| Change 32582 by rgs@stcosmo on 2007/12/06 10:59:27
| 
| Damian's last word and consistency adjustments about how Attribute::Handlers
| should behave on 5.10.0. See:
| 	
| Subject: Re: [PATCH] Attribute::Handlers till ears are bleeding
| From: Damian Conway <damian@conway.org>
| Date: Mon, 03 Dec 2007 16:17:24 +1100
| Message-ID: <47539164.3030906@conway.org>
| 
| Affected files ...
| 
| ... //depot/perl/lib/Attribute/Handlers.pm#36 edit
| ... //depot/perl/lib/Attribute/Handlers/t/data_convert.t#5 edit
| ... //depot/perl/lib/Attribute/Handlers/t/linerep.t#2 edit

This fix has broken the handling of RAWDATA completely as described in
the documentation for A::H.  To prove my claim I have used this tiny
script:


        use strict;
        use warnings;

        use Attribute::Handlers;
        use Data::Dumper;
        no warnings 'redefine';

        sub A :ATTR(RAWDATA) {
                print Dumper(@_) . "\n";
        }

        my $a :A(1, 2, "Hello", 3);


With perl 5.8.8 and its version 0.78_02 of A::H I get the desired
output:

    1367:~$ perl5.8.8 ~/problem_with_attributes.pl
    $VAR1 = 'main';
    $VAR2 = 'LEXICAL';
    $VAR3 = \undef;
    $VAR4 = 'A';
    $VAR5 = '1, 2, "Hello", 3';
    $VAR6 = 'CHECK';

But with perl 5.10.0 (patch 32593) and its version 0.79 of A::H the
output looks different:

    1368:~$ perl5.10.0 ~/problem_with_attributes.pl
    $VAR1 = 'main';
    $VAR2 = 'LEXICAL';
    $VAR3 = \undef;
    $VAR4 = 'A';
    $VAR5 = '';
    $VAR6 = 'CHECK';
    $VAR7 = undef;
    $VAR8 = undef;

As you can see $VAR5 -- that is the 'data' element -- is always empty
though it should contain all the attributes as one single string.  This
breaks Test::Class 0.25 (which makes heavy use of the RAWDATA parameter)
and its test suite badly, for example.

The following small patch cures the problem for me.  With it both my
tiny script and the test suite of Test::Class work again as excepted.

And while I'm at it: the patch fixes another small problem that I
stumbled over while fixing the original one.  The documentation for A::H
says 

        If no value is associated with the attribute, "undef" is passed.

but that didn't happen since patch 32582: instead a reference to an
empty array was passed to the attribute handler.  My patch makes A::H
behave consistently again with its documentation.


*** lib/Attribute/Handlers.pm.orig	2007-12-08 11:51:11.000000000 +0100
--- lib/Attribute/Handlers.pm	2007-12-08 11:56:25.000000000 +0100
***************
*** 191,199 ****
  	$sym ||= $type eq 'CODE' ? 'ANON' : 'LEXICAL';
  	no warnings;
  	if (!$raw && defined($data)) {
! 		my $evaled = eval("package $pkg; no warnings; no strict;
! 						   local \$SIG{__WARN__}=sub{die}; [$data]");
! 		$data = $evaled unless $@;
  	}
  	$pkg->$handler($sym,
  		       (ref $sym eq 'GLOB' ? *{$sym}{ref $ref}||$ref : $ref),
--- 191,209 ----
  	$sym ||= $type eq 'CODE' ? 'ANON' : 'LEXICAL';
  	no warnings;
  	if (!$raw && defined($data)) {
! 		# if there is no value associated with the attribute, then $data is the
! 		# empty string.  The documentation says that "undef" shall be passed to
! 		# the handler and not an empty array as it would happen without the
! 		# following check.
! 
! 		if ($data ne '') {
! 			my $evaled = eval("package $pkg; no warnings; no strict;
! 					   local \$SIG{__WARN__}=sub{die}; [$data]");
! 			$data = $evaled unless $@;
! 		}
! 		else {
! 			$data = undef;
! 		}
  	}
  	$pkg->$handler($sym,
  		       (ref $sym eq 'GLOB' ? *{$sym}{ref $ref}||$ref : $ref),
*** t/op/attrhand.t.orig	2007-12-08 11:06:14.000000000 +0100
--- t/op/attrhand.t	2007-12-08 12:17:34.000000000 +0100
***************
*** 6,12 ****
      require './test.pl';
  }
  
! plan tests => 1;
  
  # test for bug #38475: parsing errors with multiline attributes
  
--- 6,12 ----
      require './test.pl';
  }
  
! plan tests => 4;
  
  # test for bug #38475: parsing errors with multiline attributes
  
***************
*** 22,27 ****
--- 22,47 ----
      ::ok(0);
  }
  
+ sub CheckData :ATTR(RAWDATA) {
+     # check that the $data element contains the given attribute parameters.
+ 
+     if ($_[4] eq "12, 14") {
+         ::ok(1) 
+     }
+     else {
+         ::ok(0)
+     }
+ }
+ 
+ sub CheckEmptyValue :ATTR() {
+     if (not defined $_[4]) {
+         ::ok(1)
+     }
+     else {
+         ::ok(0)
+     }
+ }
+ 
  package Deer;
  use base 'Antler';
  
***************
*** 35,37 ****
--- 55,62 ----
  }
  
  something();
+ 
+ sub c :CheckData(12, 14) {};
+ 
+ sub d1 :CheckEmptyValue() {};
+ sub d2 :CheckEmptyValue {};


[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=high
---
Site configuration information for perl 5.10.0:

Configured by sascha at Sat Dec  8 08:00:26 CET 2007.

Summary of my perl5 (revision 5 version 10 subversion 0 patch 32593) configuration:
  Platform:
    osname=freebsd, osvers=7.0-beta4, archname=i386-freebsd-thread-multi-64int
    uname='freebsd lefteye.localdomain 7.0-beta4 freebsd 7.0-beta4 #4: fri dec 7 22:59:54 cet 2007 root@lefteye.localdomain:usrobjusrsrcsyslefteye i386 'config_args='-Dprefix=/usr/local/perl/dist -Dsiteprefix=/usr/local/perl/site -Dvendorprefix=/usr/local/perl/vendor -Dusethreads -Duse64bitint -Uusemymalloc -Doptimize=-O2 -march=athlon-tbird -fno-strict-aliasing -Dmake=gmake -Dcf_email=blank.sascha@googlemail.com -Uusenm -Ui_malloc -Ui_varargs -Dusemallocwrap -Dusemultiplicity -d'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-pthread -DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -I/usr/local/include',
    optimize='-O2 -march=athlon-tbird -fno-strict-aliasing',
    cppflags='-pthread -DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion='', gccversion='4.2.2 20071007  [FreeBSD]', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags ='-pthread -Wl,-E  -L/usr/local/lib'
    libpth=/usr/lib /usr/local/lib
    libs=-lgdbm -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:
    RC2

---
@INC for perl 5.10.0:
    /usr/local/perl/dist/lib/5.10.0/i386-freebsd-thread-multi-64int
    /usr/local/perl/dist/lib/5.10.0
    /usr/local/perl/site/lib/site_perl/5.10.0/i386-freebsd-thread-multi-64int
    /usr/local/perl/site/lib/site_perl/5.10.0
    /usr/local/perl/vendor/lib/vendor_perl/5.10.0/i386-freebsd-thread-multi-64int
    /usr/local/perl/vendor/lib/vendor_perl/5.10.0
    /usr/local/perl/vendor/lib/vendor_perl
    .

---
Environment for perl 5.10.0:
    HOME=/usr/home/sascha
    LANG=de_DE.ISO8859-15
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/local/perl/dist/bin:/usr/home/sascha/bin:/usr/local/bin:/usr/local/sbin:/usr/bin:/usr/sbin:/bin:/sbin:/usr/games
    PERL_BADLANG (unset)
    SHELL=/usr/local/bin/bash




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About