Change 33183 by [EMAIL PROTECTED] on 2008/02/02 12:40:48
Integrate:
[ 29125]
Document the limitation of Attribute::Handlers w.r.t. UNITCHECK blocks.
[ 29243]
Add to Attribute::Handlers the ability to report caller's file and line
number. Based on:
Subject: FW: Attribute::Handlers
From: "David Feldman" <[EMAIL PROTECTED]>
Date: Wed, 25 Oct 2006 16:34:26 -0400
Message-ID: <[EMAIL PROTECTED]>
plus docs and tests.
[ 29351]
Don't AUTOLOAD DESTROY from Attribute::Handlers.
(patch by Jerry D. Hedden for CPAN bug #1911)
[ 29412]
Bring the joy of strict to Attribute::Handlers.
[ 29414]
Fix Attribute::Handlers to cope with proxy constant subroutines.
[ 32405]
Subject: [PATCH] Attribute::Handlers till ears are bleeding
From: Michael G Schwern <[EMAIL PROTECTED]>
Date: Sun, 18 Nov 2007 16:20:31 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 32488]
Change to Attribute::Handlers suggested by Damian in
Subject: Re: [PATCH] Attribute::Handlers till ears are bleeding
From: Damian Conway <[EMAIL PROTECTED]>
Date: Fri, 23 Nov 2007 07:43:05 +1100
Message-ID: <[EMAIL PROTECTED]>
[ 32489]
Bump version to 0.79
[ 32490]
The version appears in the docs too. And update release date.
[ 32496]
Disallow attributes that are not valid perl
(patch by Damian)
[ 32497]
Adjust for the RAWDATA case
[ 32555]
Revert changes 32496 and 32497 (keep them for a next version
of Attribute::Handlers)
[ 32582]
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 <[EMAIL PROTECTED]>
Date: Mon, 03 Dec 2007 16:17:24 +1100
Message-ID: <[EMAIL PROTECTED]>
[ 32583]
Update Changes and README for A::H
[ 32598]
Subject: [perl #48355] Handling of RAWDATA broken badly in
Attribute::Handlers in perl 5.10.0 RC2
From: Sascha Blank (via RT) <[EMAIL PROTECTED]>
Date: Sat, 08 Dec 2007 03:47:46 -0800
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#417 integrate
... //depot/maint-5.8/perl/lib/Attribute/Handlers.pm#8 integrate
... //depot/maint-5.8/perl/lib/Attribute/Handlers/Changes#4 integrate
... //depot/maint-5.8/perl/lib/Attribute/Handlers/README#3 integrate
... //depot/maint-5.8/perl/lib/Attribute/Handlers/t/constants.t#1 branch
... //depot/maint-5.8/perl/lib/Attribute/Handlers/t/data_convert.t#1 branch
... //depot/maint-5.8/perl/lib/Attribute/Handlers/t/linerep.t#1 branch
... //depot/maint-5.8/perl/lib/Attribute/Handlers/t/multi.t#4 integrate
... //depot/maint-5.8/perl/t/op/attrhand.t#2 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#417 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#416~33173~ 2008-02-01 11:33:57.000000000 -0800
+++ perl/MANIFEST 2008-02-02 04:40:48.000000000 -0800
@@ -1288,7 +1288,10 @@
lib/Attribute/Handlers/demo/MyClass.pm Attribute::Handlers demo
lib/Attribute/Handlers.pm Attribute::Handlers
lib/Attribute/Handlers/README Attribute::Handlers
+lib/Attribute/Handlers/t/constants.t Test constants and Attribute::Handlers
+lib/Attribute/Handlers/t/data_convert.t Test attribute data conversion
lib/Attribute/Handlers/t/multi.t See if Attribute::Handlers works
+lib/Attribute/Handlers/t/linerep.t See if Attribute::Handlers works
lib/attributes.pm For "sub foo : attrlist"
lib/AutoLoader/t/01AutoLoader.t See if AutoLoader works
lib/AutoLoader/t/02AutoSplit.t See if AutoSplit works
==== //depot/maint-5.8/perl/lib/Attribute/Handlers.pm#8 (text) ====
Index: perl/lib/Attribute/Handlers.pm
--- perl/lib/Attribute/Handlers.pm#7~26818~ 2006-01-13 06:46:10.000000000
-0800
+++ perl/lib/Attribute/Handlers.pm 2008-02-02 04:40:48.000000000 -0800
@@ -2,7 +2,9 @@
use 5.006;
use Carp;
use warnings;
-$VERSION = '0.78_02';
+use strict;
+use vars qw($VERSION $AUTOLOAD);
+$VERSION = '0.79';
# $DB::single=1;
my %symcache;
@@ -11,7 +13,10 @@
return $symcache{$pkg,$ref} if $symcache{$pkg,$ref};
$type ||= ref($ref);
my $found;
+ no strict 'refs';
foreach my $sym ( values %{$pkg."::"} ) {
+ use strict;
+ next unless ref ( \$sym ) eq 'GLOB';
return $symcache{$pkg,$ref} = \$sym
if *{$sym}{$type} && *{$sym}{$type} == $ref;
}
@@ -60,7 +65,7 @@
my $args = $3||'()';
_usage_AH_ $class unless $attr =~ $qual_id
&& $tieclass =~ $qual_id
- && eval "use base $tieclass; 1";
+ && eval "use base q\0$tieclass\0; 1";
if ($tieclass->isa('Exporter')) {
local $Exporter::ExportLevel = 2;
$tieclass->import(eval $args);
@@ -94,29 +99,31 @@
warn "Declaration of $name attribute in package $lastattr{pkg} may
clash with future reserved word\n"
if $^W and $name !~ /[A-Z]/;
foreach ( @{$validtype{$lastattr{type}}} ) {
+ no strict 'refs';
*{"$lastattr{pkg}::_ATTR_${_}_${name}"} = $lastattr{ref};
}
%lastattr = ();
}
sub AUTOLOAD {
+ return if $AUTOLOAD =~ /::DESTROY$/;
my ($class) = $AUTOLOAD =~ m/(.*)::/g;
$AUTOLOAD =~ m/_ATTR_(.*?)_(.*)/ or
croak "Can't locate class method '$AUTOLOAD' via package '$class'";
croak "Attribute handler '$2' doesn't handle $1 attributes";
}
-sub DESTROY {}
-
my $builtin = qr/lvalue|method|locked|unique|shared/;
sub _gen_handler_AH_() {
return sub {
_resolve_lastattr;
my ($pkg, $ref, @attrs) = @_;
+ my (undef, $filename, $linenum) = caller 2;
foreach (@attrs) {
my ($attr, $data) = /^([a-z_]\w*)(?:[(](.*)[)])?$/is or next;
if ($attr eq 'ATTR') {
+ no strict 'refs';
$data ||= "ANY";
$raw{$ref} = $data =~ s/\s*,?\s*RAWDATA\s*,?\s*//;
$phase{$ref}{BEGIN} = 1
@@ -141,7 +148,7 @@
my $handler = $pkg->can("_ATTR_${type}_${attr}");
next unless $handler;
my $decl = [$pkg, $ref, $attr, $data,
- $raw{$handler}, $phase{$handler}];
+ $raw{$handler}, $phase{$handler},
$filename, $linenum];
foreach my $gphase (@global_phases) {
_apply_handler_AH_($decl,$gphase)
if $global_phases{$gphase} <= $global_phase;
@@ -165,14 +172,17 @@
}
}
-*{"Attribute::Handlers::UNIVERSAL::MODIFY_${_}_ATTRIBUTES"} =
- _gen_handler_AH_ foreach @{$validtype{ANY}};
+{
+ no strict 'refs';
+ *{"Attribute::Handlers::UNIVERSAL::MODIFY_${_}_ATTRIBUTES"} =
+ _gen_handler_AH_ foreach @{$validtype{ANY}};
+}
push @UNIVERSAL::ISA, 'Attribute::Handlers::UNIVERSAL'
unless grep /^Attribute::Handlers::UNIVERSAL$/, @UNIVERSAL::ISA;
sub _apply_handler_AH_ {
my ($declaration, $phase) = @_;
- my ($pkg, $ref, $attr, $data, $raw, $handlerphase) = @$declaration;
+ my ($pkg, $ref, $attr, $data, $raw, $handlerphase, $filename, $linenum)
= @$declaration;
return unless $handlerphase->{$phase};
# print STDERR "Handling $attr on $ref in $phase with [$data]\n";
my $type = ref $ref;
@@ -180,16 +190,21 @@
my $sym = findsym($pkg, $ref);
$sym ||= $type eq 'CODE' ? 'ANON' : 'LEXICAL';
no warnings;
- my $evaled = !$raw && eval("package $pkg; no warnings;
- local \$SIG{__WARN__}=sub{die}; [$data]");
- $data = ($evaled && $data =~ /^\s*\[/) ? [$evaled]
- : ($evaled) ? $evaled
- : [$data];
+ if (!$raw && defined($data)) {
+ 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),
$attr,
- (@$data>1? $data : $data->[0]),
+ $data,
$phase,
+ $filename,
+ $linenum,
);
return 1;
}
@@ -219,8 +234,8 @@
=head1 VERSION
-This document describes version 0.78 of Attribute::Handlers,
-released October 5, 2002.
+This document describes version 0.79 of Attribute::Handlers,
+released November 25, 2007.
=head1 SYNOPSIS
@@ -291,25 +306,27 @@
derived from that package may be given attributes with the same names as
the attribute handler subroutines, which will then be called in one of
the compilation phases (i.e. in a C<BEGIN>, C<CHECK>, C<INIT>, or C<END>
-block).
+block). (C<UNITCHECK> blocks don't correspond to a global compilation
+phase, so they can't be specified here.)
To create a handler, define it as a subroutine with the same name as
the desired attribute, and declare the subroutine itself with the
attribute C<:ATTR>. For example:
- package LoudDecl;
- use Attribute::Handlers;
+ package LoudDecl;
+ use Attribute::Handlers;
- sub Loud :ATTR {
- my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
- print STDERR
- ref($referent), " ",
- *{$symbol}{NAME}, " ",
- "($referent) ", "was just declared ",
- "and ascribed the ${attr} attribute ",
- "with data ($data)\n",
- "in phase $phase\n";
- }
+ sub Loud :ATTR {
+ my ($package, $symbol, $referent, $attr, $data, $phase, $filename,
$linenum) = @_;
+ print STDERR
+ ref($referent), " ",
+ *{$symbol}{NAME}, " ",
+ "($referent) ", "was just declared ",
+ "and ascribed the ${attr} attribute ",
+ "with data ($data)\n",
+ "in phase $phase\n",
+ "in file $filename at line $linenum\n";
+ }
This creates a handler for the attribute C<:Loud> in the class LoudDecl.
Thereafter, any subroutine declared with a C<:Loud> attribute in the class
@@ -345,7 +362,15 @@
=item [5]
-the name of the phase in which the handler is being invoked.
+the name of the phase in which the handler is being invoked;
+
+=item [6]
+
+the filename in which the handler is being invoked;
+
+=item [7]
+
+the line number in this file.
=back
@@ -370,40 +395,46 @@
string C<'LEXICAL'> in that case. Likewise, ascribing an attribute to
an anonymous subroutine results in a symbol table argument of C<'ANON'>.
-The data argument passes in the value (if any) associated with the
+The data argument passes in the value (if any) associated with the
attribute. For example, if C<&foo> had been declared:
sub foo :Loud("turn it up to 11, man!") {...}
-then the string C<"turn it up to 11, man!"> would be passed as the
-last argument.
+then a reference to an array containing the string
+C<"turn it up to 11, man!"> would be passed as the last argument.
Attribute::Handlers makes strenuous efforts to convert
the data argument (C<$_[4]>) to a useable form before passing it to
the handler (but see L<"Non-interpretive attribute handlers">).
+If those efforts succeed, the interpreted data is passed in an array
+reference; if they fail, the raw data is passed as a string.
For example, all of these:
- sub foo :Loud(till=>ears=>are=>bleeding) {...}
- sub foo :Loud(['till','ears','are','bleeding']) {...}
- sub foo :Loud(qw/till ears are bleeding/) {...}
- sub foo :Loud(qw/my, ears, are, bleeding/) {...}
- sub foo :Loud(till,ears,are,bleeding) {...}
+ sub foo :Loud(till=>ears=>are=>bleeding) {...}
+ sub foo :Loud(qw/till ears are bleeding/) {...}
+ sub foo :Loud(qw/my, ears, are, bleeding/) {...}
+ sub foo :Loud(till,ears,are,bleeding) {...}
causes it to pass C<['till','ears','are','bleeding']> as the handler's
-data argument. However, if the data can't be parsed as valid Perl, then
-it is passed as an uninterpreted string. For example:
+data argument. While:
+
+ sub foo :Loud(['till','ears','are','bleeding']) {...}
- sub foo :Loud(my,ears,are,bleeding) {...}
- sub foo :Loud(qw/my ears are bleeding) {...}
+causes it to pass C<[ ['till','ears','are','bleeding'] ]>; the array
+reference specified in the data being passed inside the standard
+array reference indicating successful interpretation.
+
+However, if the data can't be parsed as valid Perl, then
+it is passed as an uninterpreted string. For example:
-cause the strings C<'my,ears,are,bleeding'> and C<'qw/my ears are bleeding'>
-respectively to be passed as the data argument.
+ sub foo :Loud(my,ears,are,bleeding) {...}
+ sub foo :Loud(qw/my ears are bleeding) {...}
-If the attribute has only a single associated scalar data value, that value is
-passed as a scalar. If multiple values are associated, they are passed as an
-array reference. If no value is associated with the attribute, C<undef> is
-passed.
+cause the strings C<'my,ears,are,bleeding'> and
+C<'qw/my ears are bleeding'> respectively to be passed as the
+data argument.
+If no value is associated with the attribute, C<undef> is passed.
=head2 Typed lexicals
==== //depot/maint-5.8/perl/lib/Attribute/Handlers/Changes#4 (text) ====
Index: perl/lib/Attribute/Handlers/Changes
--- perl/lib/Attribute/Handlers/Changes#3~19093~ 2003-03-30
07:16:16.000000000 -0800
+++ perl/lib/Attribute/Handlers/Changes 2008-02-02 04:40:48.000000000 -0800
@@ -100,3 +100,12 @@
the proper approach is to use { '__CALLER__::foo' => __PACKAGE }.
The documentation is updated to reflect this.
Reported by Dave Cross
+
+0.79
+
+ - The version released with Perl 5.10.0
+ - All interpreted attributes are now passed as array references,
+ eventually nested.
+ - Don't AUTOLOAD DESTROY (Jerry D Hedden, cpan bug #1911)
+ - A::H is now able to report caller's file and line number
+ (David Feldman)
==== //depot/maint-5.8/perl/lib/Attribute/Handlers/README#3 (text) ====
Index: perl/lib/Attribute/Handlers/README
--- perl/lib/Attribute/Handlers/README#2~18080~ 2002-11-03 21:23:04.000000000
-0800
+++ perl/lib/Attribute/Handlers/README 2008-02-02 04:40:48.000000000 -0800
@@ -1,5 +1,5 @@
==============================================================================
- Release of version 0.78 of Attribute::Handlers
+ Release of version 0.79 of Attribute::Handlers
==============================================================================
@@ -44,28 +44,26 @@
Damian Conway ([EMAIL PROTECTED])
COPYRIGHT
- Copyright (c) 2001-2002, Damian Conway. All Rights Reserved.
+ Copyright (c) 2001-2007, Damian Conway. All Rights Reserved.
This module is free software. It may be used, redistributed
and/or modified under the same terms as Perl itself.
==============================================================================
-0.78 Sat Oct 5 07:18:09 CEST 2002
-
- - [#17940] Includes :unique and :shared in the builtin types
-
- - From perl 5.8 { __CALLER__::foo => __PACKAGE } is missparsed,
- the proper approach is to use { '__CALLER__::foo' => __PACKAGE }.
- The documentation is updated to reflect this.
+0.79
+
+ - The version released with Perl 5.10.0
+ - All interpreted attributes are now passed as array references,
+ eventually nested.
+ - Don't AUTOLOAD DESTROY (Jerry D Hedden, cpan bug #1911)
+ - A::H is now able to report caller's file and line number
+ (David Feldman)
==============================================================================
AVAILABILITY
Attribute::Handlers has been uploaded to the CPAN
-and is also available from:
-
- http://www.csse.monash.edu.au/~damian/CPAN/Attribute-Handlers.tar.gz
==============================================================================
==== //depot/maint-5.8/perl/lib/Attribute/Handlers/t/constants.t#1 (text) ====
Index: perl/lib/Attribute/Handlers/t/constants.t
--- /dev/null 2008-02-01 14:47:59.480979692 -0800
+++ perl/lib/Attribute/Handlers/t/constants.t 2008-02-02 04:40:48.000000000
-0800
@@ -0,0 +1,13 @@
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+use strict;
+use Test::More tests => 1;
+use Attribute::Handlers;
+# This had been failing since the introduction of proxy constant subroutines
+use constant SETUP => undef;
+sub Test : ATTR(CODE) { };
+ok(1, "If we got here, CHECK didn't fail");
==== //depot/maint-5.8/perl/lib/Attribute/Handlers/t/data_convert.t#1 (text)
====
Index: perl/lib/Attribute/Handlers/t/data_convert.t
--- /dev/null 2008-02-01 14:47:59.480979692 -0800
+++ perl/lib/Attribute/Handlers/t/data_convert.t 2008-02-02
04:40:48.000000000 -0800
@@ -0,0 +1,54 @@
+#!/usr/bin/perl -w
+
+# Test attribute data conversion using examples from the docs
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
+use Test::More tests => 8;
+
+package LoudDecl;
+use Attribute::Handlers;
+
+sub Loud :ATTR {
+ my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
+
+ ::is_deeply( $data, $referent->(), *{$symbol}{NAME} );
+}
+
+
+sub test1 :Loud(till=>ears=>are=>bleeding) {
+ [qw(till ears are bleeding)]
+}
+
+sub test2 :Loud(['till','ears','are','bleeding']) {
+ [[qw(till ears are bleeding)]]
+}
+
+sub test3 :Loud(qw/till ears are bleeding/) {
+ [qw(till ears are bleeding)]
+}
+
+sub test4 :Loud(qw/my, ears, are, bleeding/) {
+ [('my,', 'ears,', 'are,', 'bleeding')]
+}
+
+sub test5 :Loud(till,ears,are,bleeding) {
+ [qw(till ears are bleeding)]
+}
+
+sub test6 :Loud(my,ears,are,bleeding) {
+ 'my,ears,are,bleeding';
+}
+
+sub test7 :Loud(qw/my ears are bleeding) {
+ 'qw/my ears are bleeding'; #'
+}
+
+sub test8 :Loud("turn it up to 11, man!") {
+ ['turn it up to 11, man!'];
+}
==== //depot/maint-5.8/perl/lib/Attribute/Handlers/t/linerep.t#1 (text) ====
Index: perl/lib/Attribute/Handlers/t/linerep.t
--- /dev/null 2008-02-01 14:47:59.480979692 -0800
+++ perl/lib/Attribute/Handlers/t/linerep.t 2008-02-02 04:40:48.000000000
-0800
@@ -0,0 +1,44 @@
+#!perl
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
+use Test::More tests => 18;
+use Attribute::Handlers;
+
+sub Args : ATTR(CODE) {
+ my ($package, $symbol, $referent, $attr, $data, $phase, $filename,
$linenum) = @_;
+ is( $package, 'main', 'package' );
+ is( $symbol, \*foo, 'symbol' );
+ is( $referent, \&foo, 'referent' );
+ is( $attr, 'Args', 'attr' );
+ is( ref $data, 'ARRAY', 'data' );
+ is( $data->[0], 'bar', 'data' );
+ is( $phase, 'CHECK', 'phase' );
+ is( $filename, __FILE__, 'filename' );
+ is( $linenum, 26, 'linenum' );
+}
+
+sub foo :Args(bar) {}
+
+my $bar :SArgs(grumpf);
+
+sub SArgs : ATTR(SCALAR) {
+ my ($package, $symbol, $referent, $attr, $data, $phase, $filename,
$linenum) = @_;
+ is( $package, 'main', 'package' );
+ is( $symbol, 'LEXICAL', 'symbol' );
+ is( $referent, \$bar, 'referent' );
+ is( $attr, 'SArgs', 'attr' );
+ is( ref $data, 'ARRAY', 'data' );
+ is( $data->[0], 'grumpf', 'data' );
+ is( $phase, 'CHECK', 'phase' );
+ TODO: {
+ local $TODO = "Doesn't work correctly";
+ is( $filename, __FILE__, 'filename' );
+ is( $linenum, 28, 'linenum' );
+ }
+}
==== //depot/maint-5.8/perl/lib/Attribute/Handlers/t/multi.t#4 (text) ====
Index: perl/lib/Attribute/Handlers/t/multi.t
--- perl/lib/Attribute/Handlers/t/multi.t#3~18427~ 2003-01-03
19:49:34.000000000 -0800
+++ perl/lib/Attribute/Handlers/t/multi.t 2008-02-02 04:40:48.000000000
-0800
@@ -1,3 +1,12 @@
+#!perl
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
END {print "not ok 1\n" unless $loaded;}
use v5.6.0;
use Attribute::Handlers;
==== //depot/maint-5.8/perl/t/op/attrhand.t#2 (text) ====
Index: perl/t/op/attrhand.t
--- perl/t/op/attrhand.t#1~29961~ 2007-01-24 14:12:24.000000000 -0800
+++ perl/t/op/attrhand.t 2008-02-02 04:40:48.000000000 -0800
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 1;
+plan tests => 4;
# test for bug #38475: parsing errors with multiline attributes
@@ -22,6 +22,26 @@
::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,3 +55,8 @@
}
something();
+
+sub c :CheckData(12, 14) {};
+
+sub d1 :CheckEmptyValue() {};
+sub d2 :CheckEmptyValue {};
End of Patch.
