Front page | perl.perl5.changes |
Postings from May 2008
Change 33960: Integrate:
From:
Dave Mitchell
Date:
May 31, 2008 07:30
Subject:
Change 33960: Integrate:
Change 33960 by davem@davem-pigeon on 2008/05/31 14:19:17
Integrate:
[ 33837]
Upgrade to Math-BigInt-FastCalc-0.19
[ 33899]
Upgrade to Object-Accessor-0.34
[ 33948]
Upgrade to Locale-Maketext-1.13
Affected files ...
... //depot/maint-5.10/perl/MANIFEST#32 integrate
... //depot/maint-5.10/perl/Porting/Maintainers.pl#10 integrate
... //depot/maint-5.10/perl/ext/Math/BigInt/FastCalc/FastCalc.pm#2 integrate
... //depot/maint-5.10/perl/ext/Math/BigInt/FastCalc/FastCalc.xs#2 integrate
... //depot/maint-5.10/perl/ext/Math/BigInt/FastCalc/t/bigintfc.t#2 integrate
... //depot/maint-5.10/perl/ext/Math/BigInt/FastCalc/t/bootstrap.t#2 integrate
... //depot/maint-5.10/perl/lib/Locale/Maketext.pm#2 integrate
... //depot/maint-5.10/perl/lib/Locale/Maketext/Guts.pm#2 integrate
... //depot/maint-5.10/perl/lib/Locale/Maketext/GutsLoader.pm#2 integrate
... //depot/maint-5.10/perl/lib/Object/Accessor.pm#2 integrate
... //depot/maint-5.10/perl/lib/Object/Accessor/t/06_Object-Accessor-alias.t#1 branch
Differences ...
==== //depot/maint-5.10/perl/MANIFEST#32 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#31~33958~ 2008-05-31 06:00:52.000000000 -0700
+++ perl/MANIFEST 2008-05-31 07:19:17.000000000 -0700
@@ -2322,6 +2322,7 @@
lib/Object/Accessor/t/03_Object-Accessor-local.t Object::Accessor tests
lib/Object/Accessor/t/04_Object-Accessor-lvalue.t Object::Accessor tests
lib/Object/Accessor/t/05_Object-Accessor-callback.t Object::Accessor tests
+lib/Object/Accessor/t/06_Object-Accessor-alias.t Object::Accessor tests
lib/open2.pl Open a two-ended pipe (uses IPC::Open2)
lib/open3.pl Open a three-ended pipe (uses IPC::Open3)
lib/open.pm Pragma to specify default I/O layers
==== //depot/maint-5.10/perl/Porting/Maintainers.pl#10 (text) ====
Index: perl/Porting/Maintainers.pl
--- perl/Porting/Maintainers.pl#9~33945~ 2008-05-28 13:51:40.000000000 -0700
+++ perl/Porting/Maintainers.pl 2008-05-31 07:19:17.000000000 -0700
@@ -490,7 +490,7 @@
'Locale::Maketext' =>
{
- 'MAINTAINER' => 'petdance',
+ 'MAINTAINER' => 'ferreira',
'FILES' => q[lib/Locale/Maketext.pm lib/Locale/Maketext.pod lib/Locale/Maketext/ChangeLog lib/Locale/Maketext/{Guts,GutsLoader}.pm lib/Locale/Maketext/README lib/Locale/Maketext/TPJ13.pod lib/Locale/Maketext/t],
'CPAN' => 1,
},
==== //depot/maint-5.10/perl/ext/Math/BigInt/FastCalc/FastCalc.pm#2 (text) ====
Index: perl/ext/Math/BigInt/FastCalc/FastCalc.pm
--- perl/ext/Math/BigInt/FastCalc/FastCalc.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/Math/BigInt/FastCalc/FastCalc.pm 2008-05-31 07:19:17.000000000 -0700
@@ -11,7 +11,7 @@
@ISA = qw(DynaLoader);
-$VERSION = '0.16';
+$VERSION = '0.19';
bootstrap Math::BigInt::FastCalc $VERSION;
@@ -60,6 +60,7 @@
1;
__END__
+=pod
=head1 NAME
==== //depot/maint-5.10/perl/ext/Math/BigInt/FastCalc/FastCalc.xs#2 (text) ====
Index: perl/ext/Math/BigInt/FastCalc/FastCalc.xs
--- perl/ext/Math/BigInt/FastCalc/FastCalc.xs#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/Math/BigInt/FastCalc/FastCalc.xs 2008-05-31 07:19:17.000000000 -0700
@@ -2,6 +2,11 @@
#include "perl.h"
#include "XSUB.h"
+/* for Perl prior to v5.7.1 */
+#ifndef SvUOK
+# define SvUOK(sv) SvIOK_UV(sv)
+#endif
+
double XS_BASE = 0;
double XS_BASE_LEN = 0;
@@ -61,7 +66,7 @@
/* create the array */
RETVAL = newAV();
sv_2mortal((SV*)RETVAL);
- if (SvIOK(x) && SvUV(x) < XS_BASE)
+ if (SvUOK(x) && SvUV(x) < XS_BASE)
{
/* shortcut for integer arguments */
av_push (RETVAL, newSVuv( SvUV(x) ));
@@ -112,7 +117,7 @@
a = (AV*)SvRV(x); /* ref to aray, don't check ref */
elems = av_len(a); /* number of elems in array */
a2 = (AV*)sv_2mortal((SV*)newAV());
- av_extend (a2, elems); /* prepadd */
+ av_extend (a2, elems); /* pre-padd */
while (elems >= 0)
{
/* av_store( a2, elems, newSVsv( (SV*)*av_fetch(a, elems, 0) ) ); */
@@ -201,7 +206,7 @@
while (index <= elems)
{
temp = *av_fetch(a, index, 0); /* fetch ptr to current element */
- sv_setnv (temp, SvNV(temp)-1);
+ sv_setnv (temp, SvNV(temp)-1); /* decrement */
if (SvNV(temp) >= 0)
{
break; /* early out */
==== //depot/maint-5.10/perl/ext/Math/BigInt/FastCalc/t/bigintfc.t#2 (text) ====
Index: perl/ext/Math/BigInt/FastCalc/t/bigintfc.t
--- perl/ext/Math/BigInt/FastCalc/t/bigintfc.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/Math/BigInt/FastCalc/t/bigintfc.t 2008-05-31 07:19:17.000000000 -0700
@@ -9,7 +9,7 @@
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
unshift @INC, '../blib/arch'; # for running manually
- plan tests => 361;
+ plan tests => 359;
}
use Math::BigInt::FastCalc;
@@ -32,14 +32,6 @@
ok (ref($x),'ARRAY'); ok ($C->_str($x),123); ok ($C->_str($y),321);
###############################################################################
-# _new(0xffffffff) (the test is important for 32 bit Perls)
-
-my $ff = $C->_new(0xffffffff);
-
-ok ($C->_str($ff),"4294967295"); # must not be -1
-ok (scalar @{ $ff }, 2); # must be two parts
-
-###############################################################################
# _add, _sub, _mul, _div
ok ($C->_str($C->_add($x,$y)),444);
ok ($C->_str($C->_sub($x,$y)),123);
==== //depot/maint-5.10/perl/ext/Math/BigInt/FastCalc/t/bootstrap.t#2 (text) ====
Index: perl/ext/Math/BigInt/FastCalc/t/bootstrap.t
--- perl/ext/Math/BigInt/FastCalc/t/bootstrap.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/Math/BigInt/FastCalc/t/bootstrap.t 2008-05-31 07:19:17.000000000 -0700
@@ -6,6 +6,7 @@
$| = 1;
unshift @INC, '../blib/lib';
unshift @INC, '../blib/arch';
+ unshift @INC, '../lib';
chdir 't' if -d 't';
plan tests => 1;
};
==== //depot/maint-5.10/perl/lib/Locale/Maketext.pm#2 (text) ====
Index: perl/lib/Locale/Maketext.pm
--- perl/lib/Locale/Maketext.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Locale/Maketext.pm 2008-05-31 07:19:17.000000000 -0700
@@ -10,7 +10,7 @@
BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
# define the constant 'DEBUG' at compile-time
-$VERSION = '1.12';
+$VERSION = '1.13';
@ISA = ();
$MATCH_SUPERS = 1;
@@ -189,9 +189,9 @@
foreach my $h_r (
@{ $isa_scan{ref($handle) || $handle} || $handle->_lex_refs }
) {
- DEBUG and print "* Looking up \"$phrase\" in $h_r\n";
+ DEBUG and warn "* Looking up \"$phrase\" in $h_r\n";
if(exists $h_r->{$phrase}) {
- DEBUG and print " Found \"$phrase\" in $h_r\n";
+ DEBUG and warn " Found \"$phrase\" in $h_r\n";
unless(ref($value = $h_r->{$phrase})) {
# Nonref means it's not yet compiled. Compile and replace.
$value = $h_r->{$phrase} = $handle->_compile($value);
@@ -200,7 +200,7 @@
}
elsif($phrase !~ m/^_/s and $h_r->{'_AUTO'}) {
# it's an auto lex, and this is an autoable key!
- DEBUG and print " Automaking \"$phrase\" into $h_r\n";
+ DEBUG and warn " Automaking \"$phrase\" into $h_r\n";
$value = $h_r->{$phrase} = $handle->_compile($phrase);
last;
@@ -210,9 +210,9 @@
}
unless(defined($value)) {
- DEBUG and print "! Lookup of \"$phrase\" in/under ", ref($handle) || $handle, " fails.\n";
+ DEBUG and warn "! Lookup of \"$phrase\" in/under ", ref($handle) || $handle, " fails.\n";
if(ref($handle) and $handle->{'fail'}) {
- DEBUG and print "WARNING0: maketext fails looking for <$phrase>\n";
+ DEBUG and warn "WARNING0: maketext fails looking for <$phrase>\n";
my $fail;
if(ref($fail = $handle->{'fail'}) eq 'CODE') { # it's a sub reference
return &{$fail}($handle, $phrase, @_);
@@ -264,7 +264,7 @@
# Complain if they use __PACKAGE__ as a project base class?
if( @languages ) {
- DEBUG and print 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
if($USING_LANGUAGE_TAGS) { # An explicit language-list was given!
@languages =
map {; $_, I18N::LangTags::alternate_language_tags($_) }
@@ -274,7 +274,7 @@
# If it's a locale ID, try converting to a lg tag (untainted),
# otherwise nix it.
@languages;
- DEBUG and print 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
}
}
else {
@@ -302,19 +302,19 @@
# We have all these DEBUG statements because otherwise it's hard as hell
# to diagnose ifwhen something goes wrong.
- DEBUG and print 'Lgs1: ', map("<$_>", @languages), "\n";
+ DEBUG and warn 'Lgs1: ', map("<$_>", @languages), "\n";
if($USING_LANGUAGE_TAGS) {
- DEBUG and print 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
@languages = $base_class->_add_supers( @languages );
push @languages, I18N::LangTags::panic_languages(@languages);
- DEBUG and print "After adding panic languages:\n",
+ DEBUG and warn "After adding panic languages:\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
push @languages, $base_class->fallback_languages;
# You are free to override fallback_languages to return empty-list!
- DEBUG and print 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
@languages = # final bit of processing to turn them into classname things
map {
@@ -324,21 +324,21 @@
$it;
} @languages
;
- DEBUG and print "Nearing end of munging:\n",
+ DEBUG and warn "Nearing end of munging:\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
}
else {
- DEBUG and print "Bypassing language-tags.\n",
+ DEBUG and warn "Bypassing language-tags.\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
}
- DEBUG and print "Before adding fallback classes:\n",
+ DEBUG and warn "Before adding fallback classes:\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
push @languages, $base_class->fallback_language_classes;
# You are free to override that to return whatever.
- DEBUG and print "Finally:\n",
+ DEBUG and warn "Finally:\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
return @languages;
@@ -358,23 +358,23 @@
if (!$MATCH_SUPERS) {
# Nothing
- DEBUG and print "Bypassing any super-matching.\n",
+ DEBUG and warn "Bypassing any super-matching.\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
}
elsif( $MATCH_SUPERS_TIGHTLY ) {
- DEBUG and print "Before adding new supers tightly:\n",
+ DEBUG and warn "Before adding new supers tightly:\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
@languages = I18N::LangTags::implicate_supers( @languages );
- DEBUG and print "After adding new supers tightly:\n",
+ DEBUG and warn "After adding new supers tightly:\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
}
else {
- DEBUG and print "Before adding supers to end:\n",
+ DEBUG and warn "Before adding supers to end:\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
@languages = I18N::LangTags::implicate_supers_strictly( @languages );
- DEBUG and print "After adding supers to end:\n",
+ DEBUG and warn "After adding supers to end:\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
}
@@ -405,17 +405,17 @@
# weird case: we never use'd it, but there it is!
}
- DEBUG and print " About to use $module ...\n";
+ DEBUG and warn " About to use $module ...\n";
{
local $SIG{'__DIE__'};
eval "require $module"; # used to be "use $module", but no point in that.
}
if($@) {
- DEBUG and print "Error using $module \: $@\n";
+ DEBUG and warn "Error using $module \: $@\n";
return $tried{$module} = 0;
}
else {
- DEBUG and print " OK, $module is used\n";
+ DEBUG and warn " OK, $module is used\n";
return $tried{$module} = 1;
}
}
@@ -427,7 +427,7 @@
no strict 'refs';
no warnings 'once';
my $class = ref($_[0]) || $_[0];
- DEBUG and print "Lex refs lookup on $class\n";
+ DEBUG and warn "Lex refs lookup on $class\n";
return $isa_scan{$class} if exists $isa_scan{$class}; # memoization!
my @lex_refs;
@@ -435,14 +435,14 @@
if( defined( *{$class . '::Lexicon'}{'HASH'} )) {
push @lex_refs, *{$class . '::Lexicon'}{'HASH'};
- DEBUG and print '%' . $class . '::Lexicon contains ',
+ DEBUG and warn '%' . $class . '::Lexicon contains ',
scalar(keys %{$class . '::Lexicon'}), " entries\n";
}
# Implements depth(height?)-first recursive searching of superclasses.
# In hindsight, I suppose I could have just used Class::ISA!
foreach my $superclass (@{$class . '::ISA'}) {
- DEBUG and print " Super-class search into $superclass\n";
+ DEBUG and warn " Super-class search into $superclass\n";
next if $seen_r->{$superclass}++;
push @lex_refs, @{&_lex_refs($superclass, $seen_r)}; # call myself
}
==== //depot/maint-5.10/perl/lib/Locale/Maketext/Guts.pm#2 (text) ====
Index: perl/lib/Locale/Maketext/Guts.pm
--- perl/lib/Locale/Maketext/Guts.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Locale/Maketext/Guts.pm 2008-05-31 07:19:17.000000000 -0700
@@ -1,5 +1,7 @@
package Locale::Maketext::Guts;
+$VERSION = '1.13';
+
BEGIN {
# Just so we're nice and define SOMETHING in "our" package.
*zorp = sub { return scalar @_ } unless defined &zorp;
@@ -259,9 +261,9 @@
}
die q{Last chunk isn't null??} if @c and length $c[-1]; # sanity
- DEBUG and print scalar(@c), " chunks under closure\n";
+ DEBUG and warn scalar(@c), " chunks under closure\n";
if(@code == 0) { # not possible?
- DEBUG and print "Empty code\n";
+ DEBUG and warn "Empty code\n";
return \'';
}
elsif(@code > 1) { # most cases, presumably!
@@ -270,7 +272,7 @@
unshift @code, "use strict; sub {\n";
push @code, "}\n";
- DEBUG and print @code;
+ DEBUG and warn @code;
my $sub = eval(join '', @code);
die "$@ while evalling" . join('', @code) if $@; # Should be impossible.
return $sub;
==== //depot/maint-5.10/perl/lib/Locale/Maketext/GutsLoader.pm#2 (text) ====
Index: perl/lib/Locale/Maketext/GutsLoader.pm
--- perl/lib/Locale/Maketext/GutsLoader.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Locale/Maketext/GutsLoader.pm 2008-05-31 07:19:17.000000000 -0700
@@ -1,5 +1,7 @@
package Locale::Maketext::GutsLoader;
+$VERSION = '1.13';
+
use strict;
sub zorp { return scalar @_ }
@@ -16,7 +18,7 @@
#
$Locale::Maketext::GUTSPATH = '';
-Locale::Maketext::DEBUG and print "Requiring Locale::Maketext::Guts...\n";
+Locale::Maketext::DEBUG and warn "Requiring Locale::Maketext::Guts...\n";
eval 'require Locale::Maketext::Guts';
if ($@) {
@@ -38,10 +40,10 @@
}
eval $source;
die "Can't compile $path\n...The error I got was:\n$@\nAborting" if $@;
- Locale::Maketext::DEBUG and print "Non-utf8'd Locale::Maketext::Guts fine\n";
+ Locale::Maketext::DEBUG and warn "Non-utf8'd Locale::Maketext::Guts fine\n";
}
else {
- Locale::Maketext::DEBUG and print "Loaded Locale::Maketext::Guts fine\n";
+ Locale::Maketext::DEBUG and warn "Loaded Locale::Maketext::Guts fine\n";
}
1;
==== //depot/maint-5.10/perl/lib/Object/Accessor.pm#2 (text) ====
Index: perl/lib/Object/Accessor.pm
--- perl/lib/Object/Accessor.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Object/Accessor.pm 2008-05-31 07:19:17.000000000 -0700
@@ -10,12 +10,13 @@
### disable string overloading for callbacks
require overload;
-$VERSION = '0.32';
+$VERSION = '0.34';
$FATAL = 0;
$DEBUG = 0;
use constant VALUE => 0; # array index in the hash value
use constant ALLOW => 1; # array index in the hash value
+use constant ALIAS => 2; # array index in the hash value
=head1 NAME
@@ -32,6 +33,9 @@
$bool = $obj->mk_accessors('foo'); # create accessors
$bool = $obj->mk_accessors( # create accessors with input
{foo => ALLOW_HANDLER} ); # validation
+
+ $bool = $obj->mk_aliases( # create an alias to an existing
+ alias_name => 'method'); # method name
$clone = $obj->mk_clone; # create a clone of original
# object without data
@@ -240,6 +244,42 @@
: sub { 1 };
}
+=head2 $bool = $self->mk_aliases( alias => method, [alias2 => method2, ...] );
+
+Creates an alias for a given method name. For all intents and purposes,
+these two accessors are now identical for this object. This is akin to
+doing the following on the symbol table level:
+
+ *alias = *method
+
+This allows you to do the following:
+
+ $self->mk_accessors('foo');
+ $self->mk_aliases( bar => 'foo' );
+
+ $self->bar( 42 );
+ print $self->foo; # will print 42
+
+=cut
+
+sub mk_aliases {
+ my $self = shift;
+ my %aliases = @_;
+
+ while( my($alias, $method) = each %aliases ) {
+
+ ### already created apparently
+ if( exists $self->{$alias} ) {
+ __PACKAGE__->___debug( "Accessor '$alias' already exists");
+ next;
+ }
+
+ $self->___alias( $alias => $method );
+ }
+
+ return 1;
+}
+
=head2 $clone = $self->mk_clone;
Makes a clone of the current object, which will have the exact same
@@ -257,11 +297,16 @@
### split out accessors with and without allow handlers, so we
### don't install dummy allow handers (which makes O::A::lvalue
- ### warn for exampel)
+ ### warn for example)
my %hash; my @list;
for my $acc ( $self->ls_accessors ) {
my $allow = $self->{$acc}->[ALLOW];
$allow ? $hash{$acc} = $allow : push @list, $acc;
+
+ ### is this an alias?
+ if( my $org = $self->{ $acc }->[ ALIAS ] ) {
+ $clone->___alias( $acc => $org );
+ }
}
### copy the accessors from $self to $clone
@@ -436,6 +481,11 @@
"'$method' from somewhere else?", 1 );
}
+ ### is this is an alias, redispatch to the original method
+ if( my $original = $self->{ $method }->[ALIAS] ) {
+ return $self->___autoload( $original, @_ );
+ }
+
### assign?
my $val = $assign ? shift(@_) : $self->___get( $method );
@@ -537,6 +587,25 @@
return 1;
}
+=head2 $bool = $self->___alias( ALIAS => METHOD );
+
+Method to directly alias one accessor to another for
+this object. It circumvents all sanity checks, etc.
+
+Use only if you C<Know What You Are Doing>!
+
+=cut
+
+sub ___alias {
+ my $self = shift;
+ my $alias = shift or return;
+ my $method = shift or return;
+
+ $self->{ $alias }->[ALIAS] = $method;
+
+ return 1;
+}
+
sub ___debug {
return unless $DEBUG;
@@ -697,6 +766,8 @@
}
}
+=back
+
=head1 GLOBAL VARIABLES
=head2 $Object::Accessor::FATAL
@@ -730,20 +801,18 @@
http://rt.cpan.org/Ticket/Display.html?id=1827
+=head1 BUG REPORTS
+
+Please report bugs or other issues to E<lt>bug-object-accessor@rt.cpan.orgE<gt>.
+
=head1 AUTHOR
-This module by
-Jos Boumans E<lt>kane@cpan.orgE<gt>.
+This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
=head1 COPYRIGHT
-This module is
-copyright (c) 2004-2005 Jos Boumans E<lt>kane@cpan.orgE<gt>.
-All rights reserved.
-
-This library is free software;
-you may redistribute and/or modify it under the same
-terms as Perl itself.
+This library is free software; you may redistribute and/or modify it
+under the same terms as Perl itself.
=cut
==== //depot/maint-5.10/perl/lib/Object/Accessor/t/06_Object-Accessor-alias.t#1 (text) ====
Index: perl/lib/Object/Accessor/t/06_Object-Accessor-alias.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/Object/Accessor/t/06_Object-Accessor-alias.t 2008-05-31 07:19:17.000000000 -0700
@@ -0,0 +1,33 @@
+BEGIN { chdir 't' if -d 't' };
+
+use strict;
+use lib '../lib';
+use Test::More 'no_plan';
+use Data::Dumper;
+
+my $Class = 'Object::Accessor';
+
+use_ok($Class);
+
+my $Object = $Class->new;
+my $Acc = 'foo';
+my $Alias = 'bar';
+
+### basic sanity test
+{ ok( $Object, "Object created" );
+
+ ok( $Object->mk_accessors( $Acc ),
+ " Accessor ->$Acc created" );
+ ok( $Object->$Acc( $$ ), " ->$Acc set to $$" );
+}
+
+### alias tests
+{ ok( $Object->mk_aliases( $Alias => $Acc ),
+ "Alias ->$Alias => ->$Acc" );
+ ok( $Object->$Alias, " ->$Alias returns value" );
+ is( $Object->$Acc, $Object->$Alias,
+ " ->$Alias eq ->$Acc" );
+ ok( $Object->$Alias( $0 ), " Set value via alias ->$Alias" );
+ is( $Object->$Acc, $Object->$Alias,
+ " ->$Alias eq ->$Acc" );
+}
End of Patch.
-
Change 33960: Integrate:
by Dave Mitchell