Reintroduce Attribute::Handlers with Spider's fixes.

p4raw-id: //depot/perl@13686

15 files changed, 1392 insertions, 0 deletions

diff --git a/lib/Attribute/Handlers.pm b/lib/Attribute/Handlers.pm
new file mode 100644
index 0000000000..f12d1d9855
--- /dev/null
+++ b/lib/Attribute/Handlers.pm
@@ -0,0 +1,819 @@
+package Attribute::Handlers;
+use 5.006;
+use Carp;
+use warnings;
+$VERSION = '0.76';
+# $DB::single=1;
+
+my %symcache;
+sub findsym {
+	my ($pkg, $ref, $type) = @_;
+	return $symcache{$pkg,$ref} if $symcache{$pkg,$ref};
+	$type ||= ref($ref);
+	my $found;
+        foreach my $sym ( values %{$pkg."::"} ) {
+            return $symcache{$pkg,$ref} = \$sym
+		if *{$sym}{$type} && *{$sym}{$type} == $ref;
+	}
+}
+
+my %validtype = (
+	VAR	=> [qw[SCALAR ARRAY HASH]],
+        ANY	=> [qw[SCALAR ARRAY HASH CODE]],
+        ""	=> [qw[SCALAR ARRAY HASH CODE]],
+        SCALAR	=> [qw[SCALAR]],
+        ARRAY	=> [qw[ARRAY]],
+        HASH	=> [qw[HASH]],
+        CODE	=> [qw[CODE]],
+);
+my %lastattr;
+my @declarations;
+my %raw;
+my %phase;
+my %sigil = (SCALAR=>'$', ARRAY=>'@', HASH=>'%');
+my $global_phase = 0;
+my %global_phases = (
+	BEGIN	=> 0,
+	CHECK	=> 1,
+	INIT	=> 2,
+	END	=> 3,
+);
+my @global_phases = qw(BEGIN CHECK INIT END);
+
+sub _usage_AH_ {
+	croak "Usage: use $_[0] autotie => {AttrName => TieClassName,...}";
+}
+
+my $qual_id = qr/^[_a-z]\w*(::[_a-z]\w*)*$/i;
+
+sub import {
+    my $class = shift @_;
+    return unless $class eq "Attribute::Handlers";
+    while (@_) {
+	my $cmd = shift;
+        if ($cmd =~ /^autotie((?:ref)?)$/) {
+	    my $tiedata = ($1 ? '$ref, ' : '') . '@$data';
+            my $mapping = shift;
+	    _usage_AH_ $class unless ref($mapping) eq 'HASH';
+	    while (my($attr, $tieclass) = each %$mapping) {
+                $tieclass =~ s/^([_a-z]\w*(::[_a-z]\w*)*)(.*)/$1/is;
+		my $args = $3||'()';
+		_usage_AH_ $class unless $attr =~ $qual_id
+		                 && $tieclass =~ $qual_id
+		                 && eval "use base $tieclass; 1";
+	        if ($tieclass->isa('Exporter')) {
+		    local $Exporter::ExportLevel = 2;
+		    $tieclass->import(eval $args);
+	        }
+		$attr =~ s/__CALLER__/caller(1)/e;
+		$attr = caller()."::".$attr unless $attr =~ /::/;
+	        eval qq{
+	            sub $attr : ATTR(VAR) {
+			my (\$ref, \$data) = \@_[2,4];
+			my \$was_arrayref = ref \$data eq 'ARRAY';
+			\$data = [ \$data ] unless \$was_arrayref;
+			my \$type = ref(\$ref)||"value (".(\$ref||"<undef>").")";
+			 (\$type eq 'SCALAR')? tie \$\$ref,'$tieclass',$tiedata
+			:(\$type eq 'ARRAY') ? tie \@\$ref,'$tieclass',$tiedata
+			:(\$type eq 'HASH')  ? tie \%\$ref,'$tieclass',$tiedata
+			: die "Can't autotie a \$type\n"
+	            } 1
+	        } or die "Internal error: $@";
+	    }
+        }
+        else {
+            croak "Can't understand $_"; 
+        }
+    }
+}
+sub _resolve_lastattr {
+	return unless $lastattr{ref};
+	my $sym = findsym @lastattr{'pkg','ref'}
+		or die "Internal error: $lastattr{pkg} symbol went missing";
+	my $name = *{$sym}{NAME};
+	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}}} ) {
+		*{"$lastattr{pkg}::_ATTR_${_}_${name}"} = $lastattr{ref};
+	}
+	%lastattr = ();
+}
+
+sub AUTOLOAD {
+	my ($class) = $AUTOLOAD =~ m/(.*)::/g;
+	$AUTOLOAD =~ m/_ATTR_(.*?)_(.*)/ or
+	    croak "Can't locate class method '$AUTOLOAD' via package '$class'";
+	croak "Attribute handler '$3' doesn't handle $2 attributes";
+}
+
+sub DESTROY {}
+
+my $builtin = qr/lvalue|method|locked/;
+
+sub _gen_handler_AH_() {
+	return sub {
+	    _resolve_lastattr;
+	    my ($pkg, $ref, @attrs) = @_;
+	    foreach (@attrs) {
+		my ($attr, $data) = /^([a-z_]\w*)(?:[(](.*)[)])?$/is or next;
+		if ($attr eq 'ATTR') {
+			$data ||= "ANY";
+			$raw{$ref} = $data =~ s/\s*,?\s*RAWDATA\s*,?\s*//;
+			$phase{$ref}{BEGIN} = 1
+				if $data =~ s/\s*,?\s*(BEGIN)\s*,?\s*//;
+			$phase{$ref}{INIT} = 1
+				if $data =~ s/\s*,?\s*(INIT)\s*,?\s*//;
+			$phase{$ref}{END} = 1
+				if $data =~ s/\s*,?\s*(END)\s*,?\s*//;
+			$phase{$ref}{CHECK} = 1
+				if $data =~ s/\s*,?\s*(CHECK)\s*,?\s*//
+				|| ! keys %{$phase{$ref}};
+			# Added for cleanup to not pollute next call.
+			(%lastattr = ()),
+			croak "Can't have two ATTR specifiers on one subroutine"
+				if keys %lastattr;
+			croak "Bad attribute type: ATTR($data)"
+				unless $validtype{$data};
+			%lastattr=(pkg=>$pkg,ref=>$ref,type=>$data);
+		}
+		else {
+			my $handler = $pkg->can($attr);
+			next unless $handler;
+		        my $decl = [$pkg, $ref, $attr, $data,
+				    $raw{$handler}, $phase{$handler}];
+			foreach my $gphase (@global_phases) {
+			    _apply_handler_AH_($decl,$gphase)
+				if $global_phases{$gphase} <= $global_phase;
+			}
+			push @declarations, $decl;
+		}
+		$_ = undef;
+	    }
+	    return grep {defined && !/$builtin/} @attrs;
+	}
+}
+
+*{"MODIFY_${_}_ATTRIBUTES"} = _gen_handler_AH_ foreach @{$validtype{ANY}};
+push @UNIVERSAL::ISA, 'Attribute::Handlers'
+	unless grep /^Attribute::Handlers$/, @UNIVERSAL::ISA;
+
+sub _apply_handler_AH_ {
+	my ($declaration, $phase) = @_;
+	my ($pkg, $ref, $attr, $data, $raw, $handlerphase) = @$declaration;
+	return unless $handlerphase->{$phase};
+	# print STDERR "Handling $attr on $ref in $phase with [$data]\n";
+	my $type = ref $ref;
+	my $handler = "_ATTR_${type}_${attr}";
+	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];
+	$pkg->$handler($sym,
+		       (ref $sym eq 'GLOB' ? *{$sym}{ref $ref}||$ref : $ref),
+		       $attr,
+		       (@$data>1? $data : $data->[0]),
+		       $phase,
+		      );
+	return 1;
+}
+
+CHECK {
+	$global_phase++;
+	_resolve_lastattr;
+	_apply_handler_AH_($_,'CHECK') foreach @declarations;
+}
+
+INIT { $global_phase++; _apply_handler_AH_($_,'INIT') foreach @declarations }
+
+END { $global_phase++; _apply_handler_AH_($_,'END') foreach @declarations }
+
+1;
+__END__
+
+=head1 NAME
+
+Attribute::Handlers - Simpler definition of attribute handlers
+
+=head1 VERSION
+
+This document describes version 0.76 of Attribute::Handlers,
+released November 15, 2001.
+
+=head1 SYNOPSIS
+
+	package MyClass;
+	require v5.6.0;
+	use Attribute::Handlers;
+	no warnings 'redefine';
+
+
+	sub Good : ATTR(SCALAR) {
+		my ($package, $symbol, $referent, $attr, $data) = @_;
+
+		# Invoked for any scalar variable with a :Good attribute,
+		# provided the variable was declared in MyClass (or
+		# a derived class) or typed to MyClass.
+
+		# Do whatever to $referent here (executed in CHECK phase).
+		...
+	}
+
+	sub Bad : ATTR(SCALAR) {
+		# Invoked for any scalar variable with a :Bad attribute,
+		# provided the variable was declared in MyClass (or
+		# a derived class) or typed to MyClass.
+		...
+	}
+
+	sub Good : ATTR(ARRAY) {
+		# Invoked for any array variable with a :Good attribute,
+		# provided the variable was declared in MyClass (or
+		# a derived class) or typed to MyClass.
+		...
+	}
+
+	sub Good : ATTR(HASH) {
+		# Invoked for any hash variable with a :Good attribute,
+		# provided the variable was declared in MyClass (or
+		# a derived class) or typed to MyClass.
+		...
+	}
+
+	sub Ugly : ATTR(CODE) {
+		# Invoked for any subroutine declared in MyClass (or a 
+		# derived class) with an :Ugly attribute.
+		...
+	}
+
+	sub Omni : ATTR {
+		# Invoked for any scalar, array, hash, or subroutine
+		# with an :Omni attribute, provided the variable or
+		# subroutine was declared in MyClass (or a derived class)
+		# or the variable was typed to MyClass.
+		# Use ref($_[2]) to determine what kind of referent it was.
+		...
+	}
+
+
+	use Attribute::Handlers autotie => { Cycle => Tie::Cycle };
+
+	my $next : Cycle(['A'..'Z']);
+
+
+=head1 DESCRIPTION
+
+This module, when inherited by a package, allows that package's class to
+define attribute handler subroutines for specific attributes. Variables
+and subroutines subsequently defined in that package, or in packages
+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).
+
+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;
+
+	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";
+	}
+
+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
+LoudDecl:
+
+	package LoudDecl;
+
+	sub foo: Loud {...}
+
+causes the above handler to be invoked, and passed:
+
+=over
+
+=item [0]
+
+the name of the package into which it was declared;
+
+=item [1]
+
+a reference to the symbol table entry (typeglob) containing the subroutine;
+
+=item [2]
+
+a reference to the subroutine;
+
+=item [3]
+
+the name of the attribute;
+
+=item [4]
+
+any data associated with that attribute;
+
+=item [5]
+
+the name of the phase in which the handler is being invoked.
+
+=back
+
+Likewise, declaring any variables with the C<:Loud> attribute within the
+package:
+
+        package LoudDecl;
+
+        my $foo :Loud;
+        my @foo :Loud;
+        my %foo :Loud;
+
+will cause the handler to be called with a similar argument list (except,
+of course, that C<$_[2]> will be a reference to the variable).
+
+The package name argument will typically be the name of the class into
+which the subroutine was declared, but it may also be the name of a derived
+class (since handlers are inherited).
+
+If a lexical variable is given an attribute, there is no symbol table to 
+which it belongs, so the symbol table argument (C<$_[1]>) is set to the
+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 
+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.
+
+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">).
+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) {...}
+
+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:
+
+        sub foo :Loud(my,ears,are,bleeding) {...}
+        sub foo :Loud(qw/my ears are bleeding) {...}
+
+cause the strings C<'my,ears,are,bleeding'> and C<'qw/my ears are bleeding'>
+respectively to be passed as the data argument.
+
+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.
+
+
+=head2 Typed lexicals
+
+Regardless of the package in which it is declared, if a lexical variable is
+ascribed an attribute, the handler that is invoked is the one belonging to
+the package to which it is typed. For example, the following declarations:
+
+        package OtherClass;
+
+        my LoudDecl $loudobj : Loud;
+        my LoudDecl @loudobjs : Loud;
+        my LoudDecl %loudobjex : Loud;
+
+causes the LoudDecl::Loud handler to be invoked (even if OtherClass also
+defines a handler for C<:Loud> attributes).
+
+
+=head2 Type-specific attribute handlers
+
+If an attribute handler is declared and the C<:ATTR> specifier is
+given the name of a built-in type (C<SCALAR>, C<ARRAY>, C<HASH>, or C<CODE>),
+the handler is only applied to declarations of that type. For example,
+the following definition:
+
+        package LoudDecl;
+
+        sub RealLoud :ATTR(SCALAR) { print "Yeeeeow!" }
+
+creates an attribute handler that applies only to scalars:
+
+
+        package Painful;
+        use base LoudDecl;
+
+        my $metal : RealLoud;           # invokes &LoudDecl::RealLoud
+        my @metal : RealLoud;           # error: unknown attribute
+        my %metal : RealLoud;           # error: unknown attribute
+        sub metal : RealLoud {...}      # error: unknown attribute
+
+You can, of course, declare separate handlers for these types as well
+(but you'll need to specify C<no warnings 'redefine'> to do it quietly):
+
+        package LoudDecl;
+        use Attribute::Handlers;
+        no warnings 'redefine';
+
+        sub RealLoud :ATTR(SCALAR) { print "Yeeeeow!" }
+        sub RealLoud :ATTR(ARRAY) { print "Urrrrrrrrrr!" }
+        sub RealLoud :ATTR(HASH) { print "Arrrrrgggghhhhhh!" }
+        sub RealLoud :ATTR(CODE) { croak "Real loud sub torpedoed" }
+
+You can also explicitly indicate that a single handler is meant to be
+used for all types of referents like so:
+
+        package LoudDecl;
+        use Attribute::Handlers;
+
+        sub SeriousLoud :ATTR(ANY) { warn "Hearing loss imminent" }
+
+(I.e. C<ATTR(ANY)> is a synonym for C<:ATTR>).
+
+
+=head2 Non-interpretive attribute handlers
+
+Occasionally the strenuous efforts Attribute::Handlers makes to convert
+the data argument (C<$_[4]>) to a useable form before passing it to
+the handler get in the way.
+
+You can turn off that eagerness-to-help by declaring
+an attribute handler with the keyword C<RAWDATA>. For example:
+
+        sub Raw          : ATTR(RAWDATA) {...}
+        sub Nekkid       : ATTR(SCALAR,RAWDATA) {...}
+        sub Au::Naturale : ATTR(RAWDATA,ANY) {...}
+
+Then the handler makes absolutely no attempt to interpret the data it
+receives and simply passes it as a string:
+
+        my $power : Raw(1..100);        # handlers receives "1..100"
+
+=head2 Phase-specific attribute handlers
+
+By default, attribute handlers are called at the end of the compilation
+phase (in a C<CHECK> block). This seems to be optimal in most cases because
+most things that can be defined are defined by that point but nothing has
+been executed.
+
+However, it is possible to set up attribute handlers that are called at
+other points in the program's compilation or execution, by explicitly
+stating the phase (or phases) in which you wish the attribute handler to
+be called. For example:
+
+        sub Early    :ATTR(SCALAR,BEGIN) {...}
+        sub Normal   :ATTR(SCALAR,CHECK) {...}
+        sub Late     :ATTR(SCALAR,INIT) {...}
+        sub Final    :ATTR(SCALAR,END) {...}
+        sub Bookends :ATTR(SCALAR,BEGIN,END) {...}
+
+As the last example indicates, a handler may be set up to be (re)called in
+two or more phases. The phase name is passed as the handler's final argument.
+
+Note that attribute handlers that are scheduled for the C<BEGIN> phase
+are handled as soon as the attribute is detected (i.e. before any
+subsequently defined C<BEGIN> blocks are executed).
+
+
+=head2 Attributes as C<tie> interfaces
+
+Attributes make an excellent and intuitive interface through which to tie
+variables. For example:
+
+        use Attribute::Handlers;
+        use Tie::Cycle;
+
+        sub UNIVERSAL::Cycle : ATTR(SCALAR) {
+                my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
+                $data = [ $data ] unless ref $data eq 'ARRAY';
+                tie $$referent, 'Tie::Cycle', $data;
+        }
+
+        # and thereafter...
+
+        package main;
+
+        my $next : Cycle('A'..'Z');     # $next is now a tied variable
+
+        while (<>) {
+                print $next;
+        }
+
+Note that, because the C<Cycle> attribute receives its arguments in the
+C<$data> variable, if the attribute is given a list of arguments, C<$data>
+will consist of a single array reference; otherwise, it will consist of the
+single argument directly. Since Tie::Cycle requires its cycling values to
+be passed as an array reference, this means that we need to wrap
+non-array-reference arguments in an array constructor:
+
+        $data = [ $data ] unless ref $data eq 'ARRAY';
+
+Typically, however, things are the other way around: the tieable class expects
+its arguments as a flattened list, so the attribute looks like:
+
+        sub UNIVERSAL::Cycle : ATTR(SCALAR) {
+                my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
+                my @data = ref $data eq 'ARRAY' ? @$data : $data;
+                tie $$referent, 'Tie::Whatever', @data;
+        }
+
+
+This software pattern is so widely applicable that Attribute::Handlers
+provides a way to automate it: specifying C<'autotie'> in the
+C<use Attribute::Handlers> statement. So, the cycling example,
+could also be written:
+
+        use Attribute::Handlers autotie => { Cycle => 'Tie::Cycle' };
+
+        # and thereafter...
+
+        package main;
+
+        my $next : Cycle(['A'..'Z']);     # $next is now a tied variable
+
+        while (<>) {
+                print $next;
+
+Note that we now have to pass the cycling values as an array reference,
+since the C<autotie> mechanism passes C<tie> a list of arguments as a list
+(as in the Tie::Whatever example), I<not> as an array reference (as in
+the original Tie::Cycle example at the start of this section).
+
+The argument after C<'autotie'> is a reference to a hash in which each key is
+the name of an attribute to be created, and each value is the class to which
+variables ascribed that attribute should be tied.
+
+Note that there is no longer any need to import the Tie::Cycle module --
+Attribute::Handlers takes care of that automagically. You can even pass
+arguments to the module's C<import> subroutine, by appending them to the
+class name. For example:
+
+	use Attribute::Handlers
+		autotie => { Dir => 'Tie::Dir qw(DIR_UNLINK)' };
+
+If the attribute name is unqualified, the attribute is installed in the
+current package. Otherwise it is installed in the qualifier's package:
+
+        package Here;
+
+        use Attribute::Handlers autotie => {
+                Other::Good => Tie::SecureHash, # tie attr installed in Other::
+                        Bad => Tie::Taxes,      # tie attr installed in Here::
+            UNIVERSAL::Ugly => Software::Patent # tie attr installed everywhere
+        };
+
+Autoties are most commonly used in the module to which they actually tie, 
+and need to export their attributes to any module that calls them. To
+facilitiate this, Attribute::Handlers recognizes a special "pseudo-class" --
+C<__CALLER__>, which may be specified as the qualifier of an attribute:
+
+        package Tie::Me::Kangaroo:Down::Sport;
+
+        use Attribute::Handlers autotie => { __CALLER__::Roo => __PACKAGE__ };
+
+This causes Attribute::Handlers to define the C<Roo> attribute in the package
+that imports the Tie::Me::Kangaroo:Down::Sport module.
+
+=head3 Passing the tied object to C<tie>
+
+Occasionally it is important to pass a reference to the object being tied
+to the TIESCALAR, TIEHASH, etc. that ties it. 
+
+The C<autotie> mechanism supports this too. The following code:
+
+	use Attribute::Handlers autotieref => { Selfish => Tie::Selfish };
+	my $var : Selfish(@args);
+
+has the same effect as:
+
+	tie my $var, 'Tie::Selfish', @args;
+
+But when C<"autotieref"> is used instead of C<"autotie">:
+
+	use Attribute::Handlers autotieref => { Selfish => Tie::Selfish };
+	my $var : Selfish(@args);
+
+the effect is to pass the C<tie> call an extra reference to the variable
+being tied:
+
+        tie my $var, 'Tie::Selfish', \$var, @args;
+
+
+
+=head1 EXAMPLES
+
+If the class shown in L<SYNOPSIS> were placed in the MyClass.pm
+module, then the following code:
+
+        package main;
+        use MyClass;
+
+        my MyClass $slr :Good :Bad(1**1-1) :Omni(-vorous);
+
+        package SomeOtherClass;
+        use base MyClass;
+
+        sub tent { 'acle' }
+
+        sub fn :Ugly(sister) :Omni('po',tent()) {...}
+        my @arr :Good :Omni(s/cie/nt/);
+        my %hsh :Good(q/bye) :Omni(q/bus/);
+
+
+would cause the following handlers to be invoked:
+
+        # my MyClass $slr :Good :Bad(1**1-1) :Omni(-vorous);
+
+        MyClass::Good:ATTR(SCALAR)( 'MyClass',          # class
+                                    'LEXICAL',          # no typeglob
+                                    \$slr,              # referent
+                                    'Good',             # attr name
+                                    undef               # no attr data
+                                    'CHECK',            # compiler phase
+                                  );
+
+        MyClass::Bad:ATTR(SCALAR)( 'MyClass',           # class
+                                   'LEXICAL',           # no typeglob
+                                   \$slr,               # referent
+                                   'Bad',               # attr name
+                                   0                    # eval'd attr data
+                                   'CHECK',             # compiler phase
+                                 );
+
+        MyClass::Omni:ATTR(SCALAR)( 'MyClass',          # class
+                                    'LEXICAL',          # no typeglob
+                                    \$slr,              # referent
+                                    'Omni',             # attr name
+                                    '-vorous'           # eval'd attr data
+                                    'CHECK',            # compiler phase
+                                  );
+
+
+        # sub fn :Ugly(sister) :Omni('po',tent()) {...}
+
+        MyClass::UGLY:ATTR(CODE)( 'SomeOtherClass',     # class
+                                  \*SomeOtherClass::fn, # typeglob
+                                  \&SomeOtherClass::fn, # referent
+                                  'Ugly',               # attr name
+                                  'sister'              # eval'd attr data
+                                  'CHECK',              # compiler phase
+                                );
+
+        MyClass::Omni:ATTR(CODE)( 'SomeOtherClass',     # class
+                                  \*SomeOtherClass::fn, # typeglob
+                                  \&SomeOtherClass::fn, # referent
+                                  'Omni',               # attr name
+                                  ['po','acle']         # eval'd attr data
+                                  'CHECK',              # compiler phase
+                                );
+
+
+        # my @arr :Good :Omni(s/cie/nt/);
+
+        MyClass::Good:ATTR(ARRAY)( 'SomeOtherClass',    # class
+                                   'LEXICAL',           # no typeglob
+                                   \@arr,               # referent
+                                   'Good',              # attr name
+                                   undef                # no attr data
+                                   'CHECK',             # compiler phase
+                                 );
+
+        MyClass::Omni:ATTR(ARRAY)( 'SomeOtherClass',    # class
+                                   'LEXICAL',           # no typeglob
+                                   \@arr,               # referent
+                                   'Omni',              # attr name
+                                   ""                   # eval'd attr data 
+                                   'CHECK',             # compiler phase
+                                 );
+
+
+        # my %hsh :Good(q/bye) :Omni(q/bus/);
+                                  
+        MyClass::Good:ATTR(HASH)( 'SomeOtherClass',     # class
+                                  'LEXICAL',            # no typeglob
+                                  \%hsh,                # referent
+                                  'Good',               # attr name
+                                  'q/bye'               # raw attr data
+                                  'CHECK',              # compiler phase
+                                );
+                        
+        MyClass::Omni:ATTR(HASH)( 'SomeOtherClass',     # class
+                                  'LEXICAL',            # no typeglob
+                                  \%hsh,                # referent
+                                  'Omni',               # attr name
+                                  'bus'                 # eval'd attr data
+                                  'CHECK',              # compiler phase
+                                );
+
+
+Installing handlers into UNIVERSAL, makes them...err..universal.
+For example:
+
+        package Descriptions;
+        use Attribute::Handlers;
+
+        my %name;
+        sub name { return $name{$_[2]}||*{$_[1]}{NAME} }
+
+        sub UNIVERSAL::Name :ATTR {
+                $name{$_[2]} = $_[4];
+        }
+
+        sub UNIVERSAL::Purpose :ATTR {
+                print STDERR "Purpose of ", &name, " is $_[4]\n";
+        }
+
+        sub UNIVERSAL::Unit :ATTR {
+                print STDERR &name, " measured in $_[4]\n";
+        }
+
+Let's you write:
+
+        use Descriptions;
+
+        my $capacity : Name(capacity)
+                     : Purpose(to store max storage capacity for files)
+                     : Unit(Gb);
+
+
+        package Other;
+
+        sub foo : Purpose(to foo all data before barring it) { }
+
+        # etc.
+
+
+=head1 DIAGNOSTICS
+
+=over
+
+=item C<Bad attribute type: ATTR(%s)>
+
+An attribute handler was specified with an C<:ATTR(I<ref_type>)>, but the
+type of referent it was defined to handle wasn't one of the five permitted:
+C<SCALAR>, C<ARRAY>, C<HASH>, C<CODE>, or C<ANY>.
+
+=item C<Attribute handler %s doesn't handle %s attributes>
+
+A handler for attributes of the specified name I<was> defined, but not
+for the specified type of declaration. Typically encountered whe trying
+to apply a C<VAR> attribute handler to a subroutine, or a C<SCALAR>
+attribute handler to some other type of variable.
+
+=item C<Declaration of %s attribute in package %s may clash with future reserved word>
+
+A handler for an attributes with an all-lowercase name was declared. An
+attribute with an all-lowercase name might have a meaning to Perl
+itself some day, even though most don't yet. Use a mixed-case attribute
+name, instead.
+
+=item C<Can't have two ATTR specifiers on one subroutine>
+
+You just can't, okay?
+Instead, put all the specifications together with commas between them
+in a single C<ATTR(I<specification>)>.
+
+=item C<Can't autotie a %s>
+
+You can only declare autoties for types C<"SCALAR">, C<"ARRAY">, and
+C<"HASH">. They're the only things (apart from typeglobs -- which are
+not declarable) that Perl can tie.
+
+=item C<Internal error: %s symbol went missing>
+
+Something is rotten in the state of the program. An attributed
+subroutine ceased to exist between the point it was declared and the point
+at which its attribute handler(s) would have been called.
+
+=back
+
+=head1 AUTHOR
+
+Damian Conway (damian@conway.org)
+
+=head1 BUGS
+
+There are undoubtedly serious bugs lurking somewhere in code this funky :-)
+Bug reports and other feedback are most welcome.
+
+=head1 COPYRIGHT
+
+         Copyright (c) 2001, 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.
diff --git a/lib/Attribute/Handlers/Changes b/lib/Attribute/Handlers/Changes
new file mode 100644
index 0000000000..1b5e620482
--- /dev/null
+++ b/lib/Attribute/Handlers/Changes
@@ -0,0 +1,73 @@
+Revision history for Perl extension Attribute::Handlers
+
+0.50  Sat Apr 21 16:09:31 2001
+	- original version; 
+
+0.51	Tue May  1 06:33:15 2001
+
+	- Fixed fatal file path error in MANIFEST (thanks Marcel and Jost)
+
+
+0.60	Thu May 10 15:46:02 2001
+
+	- Added RAWDATA specifier
+
+	- Cleaned up documentation (thanks Garrett)
+
+	- Added warning for all-lowercase handlers (thanks Garrett)
+
+	- Added autotie functionality
+
+	- Tweaked handling of anon arrays as attribute args
+
+
+0.61	Thu May 10 16:28:06 2001
+
+	- Critical doc patch
+
+
+0.70	Sun Jun  3 07:40:03 2001
+
+	- Added __CALLER__ pseudo class for 'autotie'
+
+	- Added multi-phasic attribute handlers (thanks Garrett)
+
+	- Fixed nasty $SIG{__WARN__}-induced bug
+
+	- Cached ref/symbol mapping for better performance and more
+	  reliable symbol identification under evil typeglob manipulations
+
+	- Added option to pass arguments when autotied classes are imported
+	  (thanks Marcel)
+
+	- Fixed bug in handling of lexical SCALAR refs
+
+	- Cleaned up interactions with other class hierarchies
+	  (due to being base class of UNIVERSAL)
+
+
+0.75	Mon Sep  3 09:07:08 2001
+
+	- Cleaned up AUTOLOAD
+
+	- Numerous bug fixes (thanks Pete)
+
+	- Fixed handling of attribute data that includes a newline (thanks Pete)
+
+	- Added "autotieref" option (thanks Pete)
+
+	- Switched off $DB::single
+
+	- Changed licence for inclusion in core distribution
+
+	- Fixed 'autotie' for tied classes with multi-level names (thanks Jeff)
+
+
+0.76	Thu Nov 15 06:31:51 2001
+
+	- Fixed documentation nit (thanks Rick)
+
+	- Improving intuitiveness of autotie mechanism (thanks Marcel)
+
+	- Added $VERSION numbrs to demo modules (seems bizarre to me, but
+	  they're core too now).
diff --git a/lib/Attribute/Handlers/README b/lib/Attribute/Handlers/README
new file mode 100644
index 0000000000..c9e067c8e6
--- /dev/null
+++ b/lib/Attribute/Handlers/README
@@ -0,0 +1,74 @@
+==============================================================================
+                Release of version 0.76 of Attribute::Handlers
+==============================================================================
+
+
+NAME
+    Attribute::Handlers - Simpler definition of attribute handlers
+
+DESCRIPTION
+    This module, when inherited by a package, allows that package's class to
+    define attribute handler subroutines for specific attributes. Variables
+    and subroutines subsequently defined in that package, or in packages
+    derived from that package may be given attributes with the same names as
+    the attribute handler subroutines, which will then be called at the end
+    of the compilation phase (i.e. in a `CHECK' block).
+
+EXAMPLE
+
+	package UNIVERSAL;
+	use Attribute::Handlers;
+
+	my %name;
+	sub name { return $name{$_[2]}||*{$_[1]}{NAME} }
+
+	sub Name    :ATTR { $name{$_[2]} = $_[4] }
+
+	sub Purpose :ATTR { print STDERR "Purpose of ", &name, " is $_[4]\n" }
+
+	sub Unit    :ATTR { print STDERR &name, " measured in $_[4]\n" }
+
+
+	package main;
+
+	my $capacity : Name(capacity)
+		     : Purpose(to store max storage capacity for files)
+		     : Unit(Gb);
+
+	package Other;
+
+	sub foo : Purpose(to foo all data before barring it) { }
+
+
+AUTHOR
+    Damian Conway (damian@conway.org)
+
+COPYRIGHT
+             Copyright (c) 2001, 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.
+
+
+==============================================================================
+
+CHANGES IN VERSION 0.76
+
+
+	- Fixed documentation nit (thanks Rick)
+
+	- Improving intuitiveness of autotie mechanism (thanks Marcel)
+
+	- Added $VERSION numbrs to demo modules (seems bizarre to me, but
+	  they're core too now).
+
+
+==============================================================================
+
+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
+
+==============================================================================
diff --git a/lib/Attribute/Handlers/demo/Demo.pm b/lib/Attribute/Handlers/demo/Demo.pm
new file mode 100755
index 0000000000..e763d23b90
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/Demo.pm
@@ -0,0 +1,50 @@
+$DB::single = 1;
+
+package Demo;
+$VERSION = '1.00';
+use Attribute::Handlers;
+no warnings 'redefine';
+
+sub Demo : ATTR(SCALAR) {
+	my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
+	$data = '<undef>' unless defined $data;
+	print STDERR 'Scalar $', *{$symbol}{NAME},
+		     " ($referent) was ascribed ${attr}\n",
+		     "with data ($data)\nin phase $phase\n";
+};
+
+sub This : ATTR(SCALAR) {
+	print STDERR "This at ",
+		     join(":", map { defined() ? $_ : "" } caller(1)),
+		     "\n";
+}
+
+sub Demo : ATTR(HASH) {
+	my ($package, $symbol, $referent, $attr, $data) = @_;
+	$data = '<undef>' unless defined $data;
+	print STDERR 'Hash %', *{$symbol}{NAME},
+		     " ($referent) was ascribed ${attr} with data ($data)\n";
+};
+
+sub Demo : ATTR(CODE) {
+	my ($package, $symbol, $referent, $attr, $data) = @_;
+	$data = '<undef>' unless defined $data;
+	print STDERR 'Sub &', *{$symbol}{NAME},
+		     " ($referent) was ascribed ${attr} with data ($data)\n";
+};
+
+sub Multi : ATTR {
+	my ($package, $symbol, $referent, $attr, $data) = @_;
+	$data = '<undef>' unless defined $data;
+	print STDERR ref($referent), ' ', *{$symbol}{NAME},
+		     " ($referent) was ascribed ${attr} with data ($data)\n";
+};
+
+sub ExplMulti : ATTR(ANY) {
+	my ($package, $symbol, $referent, $attr, $data) = @_;
+	$data = '<undef>' unless defined $data;
+	print STDERR ref($referent), ' ', *{$symbol}{NAME},
+		     " ($referent) was ascribed ${attr} with data ($data)\n";
+};
+
+1;
diff --git a/lib/Attribute/Handlers/demo/Descriptions.pm b/lib/Attribute/Handlers/demo/Descriptions.pm
new file mode 100755
index 0000000000..023f6f752f
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/Descriptions.pm
@@ -0,0 +1,25 @@
+package Descriptions;
+$VERSION = '1.00';
+
+use Attribute::Handlers;
+
+my %name;
+
+sub name {
+	return $name{$_[2]}||*{$_[1]}{NAME};
+}
+
+sub UNIVERSAL::Name :ATTR {
+	$name{$_[2]} = $_[4];
+}
+
+sub UNIVERSAL::Purpose :ATTR {
+	print STDERR "Purpose of ", &name, " is $_[4]\n";
+}
+
+sub UNIVERSAL::Unit :ATTR {
+	print STDERR &name, " measured in $_[4]\n";
+}
+
+
+1;
diff --git a/lib/Attribute/Handlers/demo/MyClass.pm b/lib/Attribute/Handlers/demo/MyClass.pm
new file mode 100755
index 0000000000..079b2cc3ad
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/MyClass.pm
@@ -0,0 +1,64 @@
+package MyClass;
+$VERSION = '1.00';
+use v5.6.0;
+use base Attribute::Handlers;
+no warnings 'redefine';
+
+
+sub Good : ATTR(SCALAR) {
+	my ($package, $symbol, $referent, $attr, $data) = @_;
+
+	# Invoked for any scalar variable with a :Good attribute,
+	# provided the variable was declared in MyClass (or
+	# a derived class) or typed to MyClass.
+
+	# Do whatever to $referent here (executed in CHECK phase).
+	local $" = ", ";
+	print "MyClass::Good:ATTR(SCALAR)(@_);\n";
+};
+
+sub Bad : ATTR(SCALAR) {
+	# Invoked for any scalar variable with a :Bad attribute,
+	# provided the variable was declared in MyClass (or
+	# a derived class) or typed to MyClass.
+	local $" = ", ";
+	print "MyClass::Bad:ATTR(SCALAR)(@_);\n";
+}
+
+sub Good : ATTR(ARRAY) {
+        # Invoked for any array variable with a :Good attribute,
+        # provided the variable was declared in MyClass (or
+        # a derived class) or typed to MyClass.
+	local $" = ", ";
+	print "MyClass::Good:ATTR(ARRAY)(@_);\n";
+};
+
+sub Good : ATTR(HASH) {
+        # Invoked for any hash variable with a :Good attribute,
+        # provided the variable was declared in MyClass (or
+        # a derived class) or typed to MyClass.
+	local $" = ", ";
+	print "MyClass::Good:ATTR(HASH)(@_);\n";
+};
+
+sub Ugly : ATTR(CODE) {
+        # Invoked for any subroutine declared in MyClass (or a 
+        # derived class) with an :Ugly attribute.
+	local $" = ", ";
+	print "MyClass::UGLY:ATTR(CODE)(@_);\n";
+};
+
+sub Omni : ATTR {
+        # Invoked for any scalar, array, hash, or subroutine
+        # with an :Omni attribute, provided the variable or
+        # subroutine was declared in MyClass (or a derived class)
+        # or the variable was typed to MyClass.
+        # Use ref($_[2]) to determine what kind of referent it was.
+	local $" = ", ";
+	my $type = ref $_[2];
+	print "MyClass::OMNI:ATTR($type)(@_);\n";
+	use Data::Dumper 'Dumper';
+	print Dumper [ \@_ ];
+};
+
+1;
diff --git a/lib/Attribute/Handlers/demo/demo.pl b/lib/Attribute/Handlers/demo/demo.pl
new file mode 100755
index 0000000000..7a269e81b5
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/demo.pl
@@ -0,0 +1,31 @@
+#! /usr/local/bin/perl -w
+
+use v5.6.0;
+use base Demo;
+
+my $y : Demo :This($this) = sub : Demo(1,2,3) {};
+sub x : Demo(4, 5, 6) :Multi {}
+my %z : Demo(hash) :Multi(method,maybe);
+# my %a : NDemo(hash);
+
+{
+	package Named;
+
+	use base Demo;
+
+	sub Demo :ATTR(SCALAR) { print STDERR "tada\n" }
+
+	my $y : Demo :This($this) = sub : Demo(1,2,3) {};
+	sub x : ExplMulti :Demo(4,5,6) {}
+	my %z : ExplMulti :Demo(hash);
+	my Named $q : Demo;
+}
+
+package Other;
+
+my Demo $dother : Demo :This($this) = "okay";
+my Named $nother : Demo :This($this) = "okay";
+
+# my $unnamed : Demo;
+
+# sub foo : Demo();
diff --git a/lib/Attribute/Handlers/demo/demo_call.pl b/lib/Attribute/Handlers/demo/demo_call.pl
new file mode 100755
index 0000000000..1a97342116
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/demo_call.pl
@@ -0,0 +1,11 @@
+#! /usr/local/bin/perl -w
+
+use Attribute::Handlers;
+
+sub Call : ATTR {
+	use Data::Dumper 'Dumper';
+	print Dumper [ @_ ];
+}
+
+
+sub x : Call(some,data) { };
diff --git a/lib/Attribute/Handlers/demo/demo_chain.pl b/lib/Attribute/Handlers/demo/demo_chain.pl
new file mode 100755
index 0000000000..8999c1ccc7
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/demo_chain.pl
@@ -0,0 +1,27 @@
+#! /usr/local/bin/perl -w
+
+use Attribute::Handlers;
+
+sub Prefix : ATTR {
+  my ($glob, $sub) = @_[1,2];
+  no warnings 'redefine';
+  *$glob = sub {
+                 print "This happens first\n";
+                 $sub->(@_);
+               };
+}
+
+sub Postfix : ATTR {
+  my ($glob, $sub) = @_[1,2];
+  no warnings 'redefine';
+  *$glob = sub {
+                 $sub->(@_);
+                 print "This happens last\n";
+               };
+}
+
+sub test : Postfix Prefix {
+  print "Hello World\n";
+}
+
+test();
diff --git a/lib/Attribute/Handlers/demo/demo_cycle.pl b/lib/Attribute/Handlers/demo/demo_cycle.pl
new file mode 100755
index 0000000000..5f307a7036
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/demo_cycle.pl
@@ -0,0 +1,25 @@
+package Selfish;
+
+sub TIESCALAR {
+	use Data::Dumper 'Dumper';
+	print Dumper [ \@_ ];
+	bless [ @_[1..$#_] ], $_[0];
+}
+
+sub FETCH {
+	use Data::Dumper 'Dumper';
+	Dumper [ @{$_[0]} ];
+}
+
+package main;
+
+use Attribute::Handlers autotieref => { Selfish => Selfish };
+
+my $next : Selfish("me");
+print "$next\n";
+
+my $last : Selfish("you","them","who?");
+print "$last\n";
+
+my $other : Selfish(["you","them","who?"]);
+print "$other\n";
diff --git a/lib/Attribute/Handlers/demo/demo_hashdir.pl b/lib/Attribute/Handlers/demo/demo_hashdir.pl
new file mode 100755
index 0000000000..75e252b1a0
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/demo_hashdir.pl
@@ -0,0 +1,9 @@
+use Attribute::Handlers autotie => { Dir => 'Tie::Dir qw(DIR_UNLINK)' };
+
+my %dot : Dir('.', DIR_UNLINK);
+
+print join "\n", keys %dot;
+
+delete $dot{killme};
+
+print join "\n", keys %dot;
diff --git a/lib/Attribute/Handlers/demo/demo_phases.pl b/lib/Attribute/Handlers/demo/demo_phases.pl
new file mode 100755
index 0000000000..022f7e1537
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/demo_phases.pl
@@ -0,0 +1,18 @@
+#! /usr/local/bin/perl -w
+
+use Attribute::Handlers;
+use Data::Dumper 'Dumper';
+
+sub UNIVERSAL::Beginner : ATTR(SCALAR,BEGIN,END)
+	{ print STDERR "Beginner: ", Dumper \@_}
+
+sub UNIVERSAL::Checker : ATTR(CHECK,SCALAR)
+	{ print STDERR "Checker: ", Dumper \@_}
+
+sub UNIVERSAL::Initer : ATTR(SCALAR,INIT)
+	{ print STDERR "Initer: ", Dumper \@_}
+
+package Other;
+
+my $x :Initer(1) :Checker(2) :Beginner(3);
+my $y :Initer(4) :Checker(5) :Beginner(6);
diff --git a/lib/Attribute/Handlers/demo/demo_range.pl b/lib/Attribute/Handlers/demo/demo_range.pl
new file mode 100755
index 0000000000..b63d518ee5
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/demo_range.pl
@@ -0,0 +1,21 @@
+package UNIVERSAL;
+use Attribute::Handlers;
+use Tie::RangeHash;
+
+sub Ranged : ATTR(HASH) {
+	my ($package, $symbol, $referent, $attr, $data) = @_;
+	tie %$referent, 'Tie::RangeHash';
+}
+
+package main;
+
+my %next : Ranged;
+
+$next{'cat,dog'} = "animal";
+$next{'fish,fowl'} = "meal";
+$next{'heaven,hell'} = "reward";
+
+while (<>) {
+	chomp;
+	print $next{$_}||"???", "\n";
+}
diff --git a/lib/Attribute/Handlers/demo/demo_rawdata.pl b/lib/Attribute/Handlers/demo/demo_rawdata.pl
new file mode 100755
index 0000000000..c0754f06a9
--- /dev/null
+++ b/lib/Attribute/Handlers/demo/demo_rawdata.pl
@@ -0,0 +1,12 @@
+package UNIVERSAL;
+use Attribute::Handlers;
+
+sub Cooked : ATTR(SCALAR) { print pop, "\n" }
+sub PostRaw : ATTR(SCALAR,RAWDATA) { print pop, "\n" }
+sub PreRaw : ATTR(SCALAR,RAWDATA) { print pop, "\n" }
+
+package main;
+
+my $x : Cooked(1..5);
+my $y : PreRaw(1..5);
+my $z : PostRaw(1..5);
diff --git a/lib/Attribute/Handlers/t/multi.t b/lib/Attribute/Handlers/t/multi.t
new file mode 100644
index 0000000000..cc57889183
--- /dev/null
+++ b/lib/Attribute/Handlers/t/multi.t
@@ -0,0 +1,133 @@
+END {print "not ok 1\n" unless $loaded;}
+use v5.6.0;
+use Attribute::Handlers;
+$loaded = 1;
+
+CHECK { $main::phase++ }
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+sub ok { $::count++; push @::results, [$_[1], $_[0]?"":"not "]; }
+
+END { print "1..$::count\n";
+      print map "$_->[1]ok $_->[0]\n",
+		sort {$a->[0]<=>$b->[0]}
+			grep $_->[0], @::results }
+
+package Test;
+use warnings;
+no warnings 'redefine';
+
+sub UNIVERSAL::Lastly :ATTR(INIT) { ::ok $_[4][0] && $main::phase, $_[4][1] }
+
+sub UNIVERSAL::Okay :ATTR(BEGIN) {
+::ok $_[4][0] && (!$main::phase || !ref $_[1] && $_[1] eq 'LEXICAL'), $_[4][1];
+}
+
+sub Dokay :ATTR(SCALAR) { ::ok @{$_[4]} }
+sub Dokay :ATTR(HASH)   { ::ok @{$_[4]} }
+sub Dokay :ATTR(ARRAY)  { ::ok @{$_[4]} }
+sub Dokay :ATTR(CODE)   { ::ok @{$_[4]} }
+
+sub Vokay :ATTR(VAR)    { ::ok @{$_[4]} }
+
+sub Aokay :ATTR(ANY)    { ::ok @{$_[4]} }
+
+package main;
+use warnings;
+
+my $x1 :Lastly(1,41);
+my @x1 :Lastly(1=>42);
+my %x1 :Lastly(1,43);
+sub x1 :Lastly(1,44) {}
+
+my Test $x2 :Dokay(1,5);
+
+package Test;
+my $x3 :Dokay(1,6);
+my Test $x4 :Dokay(1,7);
+sub x3 :Dokay(1,8) {}
+
+my $y1 :Okay(1,9);
+my @y1 :Okay(1,10);
+my %y1 :Okay(1,11);
+sub y1 :Okay(1,12) {}
+
+my $y2 :Vokay(1,13);
+my @y2 :Vokay(1,14);
+my %y2 :Vokay(1,15);
+# BEGIN {eval 'sub y2 :Vokay(0,16) {}; 1' or
+::ok(1,16);
+# }
+
+my $z :Aokay(1,17);
+my @z :Aokay(1,18);
+my %z :Aokay(1,19);
+sub z :Aokay(1,20) {};
+
+package DerTest;
+use base 'Test';
+use warnings;
+
+my $x5 :Dokay(1,21);
+my Test $x6 :Dokay(1,22);
+sub x5 :Dokay(1,23);
+
+my $y3 :Okay(1,24);
+my @y3 :Okay(1,25);
+my %y3 :Okay(1,26);
+sub y3 :Okay(1,27) {}
+
+package Unrelated;
+
+my $x11 :Okay(1,1);
+my @x11 :Okay(1=>2);
+my %x11 :Okay(1,3);
+sub x11 :Okay(1,4) {}
+
+BEGIN { eval 'my $x7 :Dokay(0,28)' or ::ok(1,28); }
+my Test $x8 :Dokay(1,29);
+eval 'sub x7 :Dokay(0,30) {}' or ::ok(1,30);
+
+
+package Tie::Loud;
+
+sub TIESCALAR { ::ok(1,31); bless {}, $_[0] }
+sub FETCH { ::ok(1,32); return 1 }
+sub STORE { ::ok(1,33); return 1 }
+
+package Tie::Noisy;
+
+sub TIEARRAY { ::ok(1,$_[1]); bless {}, $_[0] }
+sub FETCH { ::ok(1,35); return 1 }
+sub STORE { ::ok(1,36); return 1 }
+sub FETCHSIZE { 100 }
+
+package Tie::Row::dy;
+
+sub TIEHASH { ::ok(1,$_[1]); bless {}, $_[0] }
+sub FETCH { ::ok(1,38); return 1 }
+sub STORE { ::ok(1,39); return 1 }
+
+package main;
+
+eval 'sub x7 :ATTR(SCALAR) :ATTR(CODE) {}' and ::ok(0,40) or ::ok(1,40);
+
+use Attribute::Handlers autotie => {      Other::Loud => Tie::Loud,
+				                Noisy => Tie::Noisy,
+				     UNIVERSAL::Rowdy => Tie::Row::dy,
+                                   };
+
+my Other $loud : Loud;
+$loud++;
+
+my @noisy : Noisy(34);
+$noisy[0]++;
+
+my %rowdy : Rowdy(37,'this arg should be ignored');
+$rowdy{key}++;
+