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

Handling of RAWDATA broken badly in Attribute::Handlers in perl 5.10.0 RC2 #9146

Closed
p5pRT opened this issue Dec 8, 2007 · 5 comments
Closed

Comments

@p5pRT
Copy link

p5pRT commented Dec 8, 2007

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

Searchable as RT48355$

@p5pRT
Copy link
Author

p5pRT commented Dec 8, 2007

From blank.sascha@googlemail.com

Created by blank.sascha@googlemail.com

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 {};

Perl Info

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

@p5pRT
Copy link
Author

p5pRT commented Dec 8, 2007

From @rgs

On 08/12/2007, via RT Sascha Blank <perlbug-followup@​perl.org> wrote​:

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&#8203;::Handlers;
    use Data&#8203;::Dumper;
    no warnings 'redefine';

    sub A :ATTR\(RAWDATA\) \{
            print Dumper\(@&#8203;\_\) \. "\\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&#8203;:\~$ 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&#8203;:\~$ 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.

Thanks, I've applied your patch as #32598 to bleadperl and confirmed
it solves the failures in Test​::Class, Getopt​::Attribute and
Attribute​::Overload. Attribute​::Types, however, still fails.

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 {};

@p5pRT
Copy link
Author

p5pRT commented Dec 8, 2007

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

@p5pRT
Copy link
Author

p5pRT commented Dec 8, 2007

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

@p5pRT p5pRT closed this as completed Dec 8, 2007
@p5pRT
Copy link
Author

p5pRT commented Dec 9, 2007

From @andk

On Sun, 9 Dec 2007 00​:32​:09 +0100, "Rafael Garcia-Suarez" <rgarciasuarez@​gmail.com> said​:

  > Thanks, I've applied your patch as #32598 to bleadperl and confirmed
  > it solves the failures in Test​::Class, Getopt​::Attribute and
  > Attribute​::Overload. Attribute​::Types, however, still fails.

For me also Attribute​::Types is fixed with 32600. perl -V appended.

--
andreas

Summary of my perl5 (revision 5 version 10 subversion 0) configuration​:
  Platform​:
  osname=linux, osvers=2.6.22-1-k7, archname=i686-linux
  uname='linux k75 2.6.22-1-k7 #1 smp sun jul 29 15​:15​:55 utc 2007 i686 gnulinux '
  config_args='-Dprefix=/home/src/perl/repoperls/installed-perls/perl/p0klOEE/perl-5.8.0@​32600 -Dinstallusrbinperl=n -Uversiononly -Dusedevel -des -Ui_db'
  hint=recommended, useposix=true, d_sigaction=define
  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 ='-fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
  optimize='-O2',
  cppflags='-fno-strict-aliasing -pipe -I/usr/local/include'
  ccversion='', gccversion='4.1.2 20061115 (prerelease) (Debian 4.1.1-21)', 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 =' -L/usr/local/lib'
  libpth=/usr/local/lib /lib /usr/lib /usr/lib64
  libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc
  perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
  libc=/lib/libc-2.6.1.so, so=so, useshrplib=false, libperl=libperl.a
  gnulibc_version='2.6.1'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
  cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib'

Characteristics of this binary (from libperl)​:
  Compile-time options​: PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP
  USE_LARGE_FILES USE_PERLIO
  Locally applied patches​:
  RC2
  patchaperlup​: --branch='perl' --upto='32600' --start='17639'
  Built under linux
  Compiled at Dec 9 2007 02​:22​:33
  @​INC​:
  /home/src/perl/repoperls/installed-perls/perl/p0klOEE/perl-5.8.0@​32600/lib/5.10.0/i686-linux
  /home/src/perl/repoperls/installed-perls/perl/p0klOEE/perl-5.8.0@​32600/lib/5.10.0
  /home/src/perl/repoperls/installed-perls/perl/p0klOEE/perl-5.8.0@​32600/lib/site_perl/5.10.0/i686-linux
  /home/src/perl/repoperls/installed-perls/perl/p0klOEE/perl-5.8.0@​32600/lib/site_perl/5.10.0
  .

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