Hello community,
here is the log from the commit of package perl-Term-Table for openSUSE:Factory
checked in at 2019-11-21 12:57:20
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Term-Table (Old)
and /work/SRC/openSUSE:Factory/.perl-Term-Table.new.26869 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Term-Table"
Thu Nov 21 12:57:20 2019 rev:6 rq:749525 version:0.015
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Term-Table/perl-Term-Table.changes
2019-10-22 15:42:08.661490962 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Term-Table.new.26869/perl-Term-Table.changes
2019-11-21 12:57:20.974552239 +0100
@@ -1,0 +2,10 @@
+Tue Nov 19 08:42:34 UTC 2019 - <[email protected]>
+
+- updated to 0.015
+ see /usr/share/doc/packages/perl-Term-Table/Changes
+
+ 0.015 2019-11-18 15:58:23-08:00 America/Los_Angeles
+
+ - Update inlined Object::HashBase
+
+-------------------------------------------------------------------
Old:
----
Term-Table-0.014.tar.gz
New:
----
Term-Table-0.015.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Term-Table.spec ++++++
--- /var/tmp/diff_new_pack.S4l3vm/_old 2019-11-21 12:57:21.446552094 +0100
+++ /var/tmp/diff_new_pack.S4l3vm/_new 2019-11-21 12:57:21.450552093 +0100
@@ -17,7 +17,7 @@
Name: perl-Term-Table
-Version: 0.014
+Version: 0.015
Release: 0
%define cpan_name Term-Table
Summary: Format a header and rows into a table
++++++ Term-Table-0.014.tar.gz -> Term-Table-0.015.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/Changes new/Term-Table-0.015/Changes
--- old/Term-Table-0.014/Changes 2019-10-16 01:54:42.000000000 +0200
+++ new/Term-Table-0.015/Changes 2019-11-19 00:58:24.000000000 +0100
@@ -1,3 +1,7 @@
+0.015 2019-11-18 15:58:23-08:00 America/Los_Angeles
+
+ - Update inlined Object::HashBase
+
0.014 2019-10-15 16:54:41-07:00 America/Los_Angeles
- Clone STDOUT on load in case it gets changed later
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/META.json
new/Term-Table-0.015/META.json
--- old/Term-Table-0.014/META.json 2019-10-16 01:54:42.000000000 +0200
+++ new/Term-Table-0.015/META.json 2019-11-19 00:58:24.000000000 +0100
@@ -55,7 +55,7 @@
"url" : "http://github.com/exodist/Term-Table/";
}
},
- "version" : "0.014",
+ "version" : "0.015",
"x_generated_by_perl" : "v5.30.0",
"x_serialization_backend" : "Cpanel::JSON::XS version 4.12"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/META.yml
new/Term-Table-0.015/META.yml
--- old/Term-Table-0.014/META.yml 2019-10-16 01:54:42.000000000 +0200
+++ new/Term-Table-0.015/META.yml 2019-11-19 00:58:24.000000000 +0100
@@ -27,6 +27,6 @@
resources:
bugtracker: http://github.com/exodist/Term-Table/issues
repository: http://github.com/exodist/Term-Table/
-version: '0.014'
+version: '0.015'
x_generated_by_perl: v5.30.0
x_serialization_backend: 'YAML::Tiny version 1.73'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/Makefile.PL
new/Term-Table-0.015/Makefile.PL
--- old/Term-Table-0.014/Makefile.PL 2019-10-16 01:54:42.000000000 +0200
+++ new/Term-Table-0.015/Makefile.PL 2019-11-19 00:58:24.000000000 +0100
@@ -26,7 +26,7 @@
"Test2::Tools::Tiny" => "1.302097",
"utf8" => 0
},
- "VERSION" => "0.014",
+ "VERSION" => "0.015",
"test" => {
"TESTS" => "t/*.t t/Table/*.t"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/lib/Term/Table/Cell.pm
new/Term-Table-0.015/lib/Term/Table/Cell.pm
--- old/Term-Table-0.014/lib/Term/Table/Cell.pm 2019-10-16 01:54:42.000000000
+0200
+++ new/Term-Table-0.015/lib/Term/Table/Cell.pm 2019-11-19 00:58:24.000000000
+0100
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = '0.014';
+our $VERSION = '0.015';
use Term::Table::LineBreak();
use Term::Table::Util qw/uni_length/;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/lib/Term/Table/CellStack.pm
new/Term-Table-0.015/lib/Term/Table/CellStack.pm
--- old/Term-Table-0.014/lib/Term/Table/CellStack.pm 2019-10-16
01:54:42.000000000 +0200
+++ new/Term-Table-0.015/lib/Term/Table/CellStack.pm 2019-11-19
00:58:24.000000000 +0100
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = '0.014';
+our $VERSION = '0.015';
use Term::Table::HashBase qw/-cells -idx/;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/lib/Term/Table/HashBase.pm
new/Term-Table-0.015/lib/Term/Table/HashBase.pm
--- old/Term-Table-0.014/lib/Term/Table/HashBase.pm 2019-10-16
01:54:42.000000000 +0200
+++ new/Term-Table-0.015/lib/Term/Table/HashBase.pm 2019-11-19
00:58:24.000000000 +0100
@@ -2,18 +2,25 @@
use strict;
use warnings;
+our $VERSION = '0.015';
+
#################################################################
# #
# This is a generated file! Do not modify this file directly! #
# Use hashbase_inc.pl script to regenerate this file. #
# The script is part of the Object::HashBase distribution. #
+# Note: You can modify the version number above this comment #
+# if needed, that is fine. #
# #
#################################################################
{
no warnings 'once';
- $Term::Table::HashBase::VERSION = '0.003';
+ $Term::Table::HashBase::HB_VERSION = '0.008';
*Term::Table::HashBase::ATTR_SUBS = \%Object::HashBase::ATTR_SUBS;
+ *Term::Table::HashBase::ATTR_LIST = \%Object::HashBase::ATTR_LIST;
+ *Term::Table::HashBase::VERSION = \%Object::HashBase::VERSION;
+ *Term::Table::HashBase::CAN_CACHE = \%Object::HashBase::CAN_CACHE;
}
@@ -37,31 +44,49 @@
}
}
-my %STRIP = (
- '^' => 1,
- '-' => 1,
+my %SPEC = (
+ '^' => {reader => 1, writer => 0, dep_writer => 1, read_only => 0, strip
=> 1},
+ '-' => {reader => 1, writer => 0, dep_writer => 0, read_only => 1, strip
=> 1},
+ '>' => {reader => 0, writer => 1, dep_writer => 0, read_only => 0, strip
=> 1},
+ '<' => {reader => 1, writer => 0, dep_writer => 0, read_only => 0, strip
=> 1},
+ '+' => {reader => 0, writer => 0, dep_writer => 0, read_only => 0, strip
=> 1},
);
sub import {
my $class = shift;
my $into = caller;
- my $isa = _isa($into);
+ # Make sure we list the OLDEST version used to create this class.
+ my $ver = $Term::Table::HashBase::HB_VERSION ||
$Term::Table::HashBase::VERSION;
+ $Term::Table::HashBase::VERSION{$into} = $ver if
!$Term::Table::HashBase::VERSION{$into} ||
$Term::Table::HashBase::VERSION{$into} > $ver;
+
+ my $isa = _isa($into);
+ my $attr_list = $Term::Table::HashBase::ATTR_LIST{$into} ||= [];
my $attr_subs = $Term::Table::HashBase::ATTR_SUBS{$into} ||= {};
- my %subs = (
+
+ my %subs = (
($into->can('new') ? () : (new => \&_new)),
(map %{$Term::Table::HashBase::ATTR_SUBS{$_} || {}}, @{$isa}[1 ..
$#$isa]),
(
map {
my $p = substr($_, 0, 1);
my $x = $_;
- substr($x, 0, 1) = '' if $STRIP{$p};
+
+ my $spec = $SPEC{$p} || {reader => 1, writer => 1};
+
+ substr($x, 0, 1) = '' if $spec->{strip};
+ push @$attr_list => $x;
my ($sub, $attr) = (uc $x, $x);
- $sub => ($attr_subs->{$sub} = sub() { $attr }),
- $attr => sub { $_[0]->{$attr} },
- $p eq '-' ? ("set_$attr" => sub { Carp::croak("'$attr' is
read-only") })
- : $p eq '^' ? ("set_$attr" => sub { Carp::carp("set_$attr() is
deprecated"); $_[0]->{$attr} = $_[1] })
- : ("set_$attr" => sub { $_[0]->{$attr} = $_[1] }),
+
+ $attr_subs->{$sub} = sub() { $attr };
+ my %out = ($sub => $attr_subs->{$sub});
+
+ $out{$attr} = sub { $_[0]->{$attr} }
if $spec->{reader};
+ $out{"set_$attr"} = sub { $_[0]->{$attr} = $_[1] }
if $spec->{writer};
+ $out{"set_$attr"} = sub { Carp::croak("'$attr' is read-only")
} if $spec->{read_only};
+ $out{"set_$attr"} = sub { Carp::carp("set_$attr() is
deprecated"); $_[0]->{$attr} = $_[1] } if $spec->{dep_writer};
+
+ %out;
} @_
),
);
@@ -70,10 +95,65 @@
*{"$into\::$_"} = $subs{$_} for keys %subs;
}
+sub attr_list {
+ my $class = shift;
+
+ my $isa = _isa($class);
+
+ my %seen;
+ my @list = grep { !$seen{$_}++ } map {
+ my @out;
+
+ if (0.004 > ($Term::Table::HashBase::VERSION{$_} || 0)) {
+ Carp::carp("$_ uses an inlined version of Term::Table::HashBase
too old to support attr_list()");
+ }
+ else {
+ my $list = $Term::Table::HashBase::ATTR_LIST{$_};
+ @out = $list ? @$list : ()
+ }
+
+ @out;
+ } reverse @$isa;
+
+ return @list;
+}
+
sub _new {
- my ($class, %params) = @_;
- my $self = bless \%params, $class;
- $self->init if $self->can('init');
+ my $class = shift;
+
+ my $self;
+
+ if (@_ == 1) {
+ my $arg = shift;
+ my $type = ref($arg);
+
+ if ($type eq 'HASH') {
+ $self = bless({%$arg}, $class)
+ }
+ else {
+ Carp::croak("Not sure what to do with '$type' in $class
constructor")
+ unless $type eq 'ARRAY';
+
+ my %proto;
+ my @attributes = attr_list($class);
+ while (@$arg) {
+ my $val = shift @$arg;
+ my $key = shift @attributes or Carp::croak("Too many arguments
for $class constructor");
+ $proto{$key} = $val;
+ }
+
+ $self = bless(\%proto, $class);
+ }
+ }
+ else {
+ $self = bless({@_}, $class);
+ }
+
+ $Term::Table::HashBase::CAN_CACHE{$class} = $self->can('init')
+ unless exists $Term::Table::HashBase::CAN_CACHE{$class};
+
+ $self->init if $Term::Table::HashBase::CAN_CACHE{$class};
+
$self;
}
@@ -98,7 +178,7 @@
use warnings;
# Generate 3 accessors
- use Term::Table::HashBase qw/foo -bar ^baz/;
+ use Term::Table::HashBase qw/foo -bar ^baz <bat >ban +boo/;
# Chance to initialize defaults
sub init {
@@ -106,10 +186,13 @@
$self->{+FOO} ||= "foo";
$self->{+BAR} ||= "bar";
$self->{+BAZ} ||= "baz";
+ $self->{+BAT} ||= "bat";
+ $self->{+BAN} ||= "ban";
+ $self->{+BOO} ||= "boo";
}
sub print {
- print join ", " => map { $self->{$_} } FOO, BAR, BAZ;
+ print join ", " => map { $self->{$_} } FOO, BAR, BAZ, BAT, BAN, BOO;
}
Subclass it
@@ -120,14 +203,14 @@
# Note, you should subclass before loading HashBase.
use base 'My::Class';
- use Term::Table::HashBase qw/bat/;
+ use Term::Table::HashBase qw/bub/;
sub init {
my $self = shift;
# We get the constants from the base class for free.
$self->{+FOO} ||= 'SubFoo';
- $self->{+BAT} ||= 'bat';
+ $self->{+BUB} ||= 'bub';
$self->SUPER::init();
}
@@ -139,12 +222,18 @@
use warnings;
use My::Class;
- my $one = My::Class->new(foo => 'MyFoo', bar => 'MyBar');
+ # These are all functionally identical
+ my $one = My::Class->new(foo => 'MyFoo', bar => 'MyBar');
+ my $two = My::Class->new({foo => 'MyFoo', bar => 'MyBar'});
+ my $three = My::Class->new(['MyFoo', 'MyBar']);
- # Accessors!
+ # Readers!
my $foo = $one->foo; # 'MyFoo'
my $bar = $one->bar; # 'MyBar'
my $baz = $one->baz; # Defaulted to: 'baz'
+ my $bat = $one->bat; # Defaulted to: 'bat'
+ # '>ban' means setter only, no reader
+ # '+boo' means no setter or reader, just the BOO constant
# Setters!
$one->set_foo('A Foo');
@@ -156,6 +245,9 @@
# deprecated.
$one->set_baz('A Baz');
+ # '<bat' means no setter defined at all
+ # '+boo' means no setter or reader, just the BOO constant
+
$one->{+FOO} = 'xxx';
=head1 DESCRIPTION
@@ -180,9 +272,13 @@
=over 4
-=item $it = $class->new(@VALUES)
+=item $it = $class->new(%PAIRS)
+
+=item $it = $class->new(\%PAIRS)
+
+=item $it = $class->new(\@ORDERED_VALUES)
-Create a new instance using key/value pairs.
+Create a new instance.
HashBase will not export C<new()> if there is already a C<new()> method in your
packages inheritance chain.
@@ -204,6 +300,21 @@
Alternatively you can define the method before loading HashBase instead of just
declaring it, but that scatters your use statements.
+The most common way to create an object is to pass in key/value pairs where
+each key is an attribute and each value is what you want assigned to that
+attribute. No checking is done to verify the attributes or values are valid,
+you may do that in C<init()> if desired.
+
+If you would like, you can pass in a hashref instead of pairs. When you do so
+the hashref will be copied, and the copy will be returned blessed as an object.
+There is no way to ask HashBase to bless a specific hashref.
+
+In some cases an object may only have 1 or 2 attributes, in which case a
+hashref may be too verbose for your liking. In these cases you can pass in an
+arrayref with only values. The values will be assigned to attributes in the
+order the attributes were listed. When there is inheritance involved the
+attributes from parent classes will come before subclasses.
+
=back
=head2 HOOKS
@@ -215,10 +326,18 @@
This gives you the chance to set some default values to your fields. The only
argument is C<$self> with its indexes already set from the constructor.
+B<Note:> Term::Table::HashBase checks for an init using C<<
$class->can('init') >>
+during construction. It DOES NOT call C<can()> on the created object. Also note
+that the result of the check is cached, it is only ever checked once, the first
+time an instance of your class is created. This means that adding an C<init()>
+method AFTER the first construction will result in it being ignored.
+
=back
=head1 ACCESSORS
+=head2 READ/WRITE
+
To generate accessors you list them when using the module:
use Term::Table::HashBase qw/foo/;
@@ -246,6 +365,50 @@
=back
+=head2 READ ONLY
+
+ use Term::Table::HashBase qw/-foo/;
+
+=over 4
+
+=item set_foo()
+
+Throws an exception telling you the attribute is read-only. This is exported to
+override any active setters for the attribute in a parent class.
+
+=back
+
+=head2 DEPRECATED SETTER
+
+ use Term::Table::HashBase qw/^foo/;
+
+=over 4
+
+=item set_foo()
+
+This will set the value, but it will also warn you that the method is
+deprecated.
+
+=back
+
+=head2 NO SETTER
+
+ use Term::Table::HashBase qw/<foo/;
+
+Only gives you a reader, no C<set_foo> method is defined at all.
+
+=head2 NO READER
+
+ use Term::Table::HashBase qw/>foo/;
+
+Only gives you a write (C<set_foo>), no C<foo> method is defined at all.
+
+=head2 CONSTANT ONLY
+
+ use Term::Table::HashBase qw/+foo/;
+
+This does not create any methods for you, it just adds the C<FOO> constant.
+
=head1 SUBCLASSING
You can subclass an existing HashBase class.
@@ -256,10 +419,31 @@
The base class is added to C<@ISA> for you, and all constants from base classes
are added to subclasses automatically.
+=head1 GETTING A LIST OF ATTRIBUTES FOR A CLASS
+
+Term::Table::HashBase provides a function for retrieving a list of attributes
for an
+Term::Table::HashBase class.
+
+=over 4
+
+=item @list = Term::Table::HashBase::attr_list($class)
+
+=item @list = $class->Term::Table::HashBase::attr_list()
+
+Either form above will work. This will return a list of attributes defined on
+the object. This list is returned in the attribute definition order, parent
+class attributes are listed before subclass attributes. Duplicate attributes
+will be removed before the list is returned.
+
+B<Note:> This list is used in the C<< $class->new(\@ARRAY) >> constructor to
+determine the attribute to which each value will be paired.
+
+=back
+
=head1 SOURCE
The source code repository for HashBase can be found at
-F<http://github.com/exodist/HashBase/>.
+F<http://github.com/Test-More/HashBase/>.
=head1 MAINTAINERS
@@ -279,7 +463,7 @@
=head1 COPYRIGHT
-Copyright 2016 Chad Granum E<lt>[email protected]<gt>.
+Copyright 2017 Chad Granum E<lt>[email protected]<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/lib/Term/Table/LineBreak.pm
new/Term-Table-0.015/lib/Term/Table/LineBreak.pm
--- old/Term-Table-0.014/lib/Term/Table/LineBreak.pm 2019-10-16
01:54:42.000000000 +0200
+++ new/Term-Table-0.015/lib/Term/Table/LineBreak.pm 2019-11-19
00:58:24.000000000 +0100
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = '0.014';
+our $VERSION = '0.015';
use Carp qw/croak/;
use Scalar::Util qw/blessed/;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/lib/Term/Table/Spacer.pm
new/Term-Table-0.015/lib/Term/Table/Spacer.pm
--- old/Term-Table-0.014/lib/Term/Table/Spacer.pm 2019-10-16
01:54:42.000000000 +0200
+++ new/Term-Table-0.015/lib/Term/Table/Spacer.pm 2019-11-19
00:58:24.000000000 +0100
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = '0.014';
+our $VERSION = '0.015';
sub new { bless {}, $_[0] }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/lib/Term/Table/Util.pm
new/Term-Table-0.015/lib/Term/Table/Util.pm
--- old/Term-Table-0.014/lib/Term/Table/Util.pm 2019-10-16 01:54:42.000000000
+0200
+++ new/Term-Table-0.015/lib/Term/Table/Util.pm 2019-11-19 00:58:24.000000000
+0100
@@ -4,7 +4,7 @@
use Config qw/%Config/;
-our $VERSION = '0.014';
+our $VERSION = '0.015';
use Importer Importer => 'import';
our @EXPORT_OK = qw/term_size USE_GCS USE_TERM_READKEY USE_TERM_SIZE_ANY
uni_length/;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/lib/Term/Table.pm
new/Term-Table-0.015/lib/Term/Table.pm
--- old/Term-Table-0.014/lib/Term/Table.pm 2019-10-16 01:54:42.000000000
+0200
+++ new/Term-Table-0.015/lib/Term/Table.pm 2019-11-19 00:58:24.000000000
+0100
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = '0.014';
+our $VERSION = '0.015';
use Term::Table::Cell();
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Term-Table-0.014/t/HashBase.t
new/Term-Table-0.015/t/HashBase.t
--- old/Term-Table-0.014/t/HashBase.t 2019-10-16 01:54:42.000000000 +0200
+++ new/Term-Table-0.015/t/HashBase.t 2019-11-19 00:58:24.000000000 +0100
@@ -90,7 +90,7 @@
package
main::HBase::Wrapped;
- use Term::Table::HashBase qw/foo bar/;
+ use Term::Table::HashBase qw/foo bar dup/;
my $foo = __PACKAGE__->can('foo');
no warnings 'redefine';
@@ -107,7 +107,7 @@
package
main::HBase::Wrapped::Inherit;
use base 'main::HBase::Wrapped';
- use Term::Table::HashBase;
+ use Term::Table::HashBase qw/baz dup/;
}
my $o = main::HBase::Wrapped::Inherit->new(foo => 1);
@@ -132,17 +132,28 @@
package
main::HBase2;
- use Term::Table::HashBase qw/foo -bar ^baz/;
+ use Term::Table::HashBase qw/foo -bar ^baz <bat >ban +boo/;
main::is(FOO, 'foo', "FOO CONSTANT");
main::is(BAR, 'bar', "BAR CONSTANT");
main::is(BAZ, 'baz', "BAZ CONSTANT");
+ main::is(BAT, 'bat', "BAT CONSTANT");
+ main::is(BAN, 'ban', "BAN CONSTANT");
+ main::is(BOO, 'boo', "BOO CONSTANT");
}
-my $ro = main::HBase2->new(foo => 'foo', bar => 'bar', baz => 'baz');
+my $ro = main::HBase2->new(foo => 'foo', bar => 'bar', baz => 'baz', bat =>
'bat', ban => 'ban');
is($ro->foo, 'foo', "got foo");
is($ro->bar, 'bar', "got bar");
is($ro->baz, 'baz', "got baz");
+is($ro->bat, 'bat', "got bat");
+ok(!$ro->can('set_bat'), "No setter for bat");
+ok(!$ro->can('ban'), "No reader for ban");
+ok(!$ro->can('boo'), "No reader for boo");
+ok(!$ro->can('set_boo'), "No setter for boo");
+is($ro->{ban}, 'ban', "ban attribute is set");
+$ro->set_ban('xxx');
+is($ro->{ban}, 'xxx', "ban attribute can be set");
is($ro->set_foo('xxx'), 'xxx', "Can set foo");
is($ro->foo, 'xxx', "got foo");
@@ -152,6 +163,84 @@
my $warnings = warnings { is($ro->set_baz('xxx'), 'xxx', 'set baz') };
like($warnings->[0], qr/set_baz\(\) is deprecated/, "Deprecation warning");
+
+
+is_deeply(
+ [Term::Table::HashBase::attr_list('main::HBase::Wrapped::Inherit')],
+ [qw/foo bar dup baz/],
+ "Got a list of attributes in order starting from base class, duplicates
removed",
+);
+
+my $x = main::HBase::Wrapped::Inherit->new(foo => 1, baz => 2);
+is($x->foo, 1, "set foo via pairs");
+is($x->baz, 2, "set baz via pairs");
+
+# Now with hashref
+my $y = main::HBase::Wrapped::Inherit->new({foo => 1, baz => 2});
+is($y->foo, 1, "set foo via hashref");
+is($y->baz, 2, "set baz via hashref");
+
+# Now with hashref
+my $z = main::HBase::Wrapped::Inherit->new([
+ 1, # foo
+ 2, # bar
+ 3, # dup
+ 4, # baz
+]);
+is($z->foo, 1, "set foo via arrayref");
+is($z->baz, 4, "set baz via arrayref");
+
+like(
+ exception { main::HBase::Wrapped::Inherit->new([1 .. 10]) },
+ qr/Too many arguments for main::HBase::Wrapped::Inherit constructor/,
+ "Too many args in array form"
+);
+
+
+my $CAN_COUNT = 0;
+my $CAN_COUNT2 = 0;
+my $INIT_COUNT = 0;
+BEGIN {
+ $INC{'Object/HashBase/Test/HBase3.pm'} = __FILE__;
+ package
+ main::HBase3;
+ use Term::Table::HashBase qw/foo/;
+
+ sub can {
+ my $self = shift;
+ $CAN_COUNT++;
+ $self->SUPER::can(@_);
+ }
+
+ $INC{'Object/HashBase/Test/HBase4.pm'} = __FILE__;
+ package
+ main::HBase4;
+ use Term::Table::HashBase qw/foo/;
+
+ sub can {
+ my $self = shift;
+ $CAN_COUNT2++;
+ $self->SUPER::can(@_);
+ }
+
+ sub init { $INIT_COUNT++ }
+}
+
+is($CAN_COUNT, 0, "->can has not been called yet");
+my $it = main::HBase3->new;
+is($CAN_COUNT, 1, "->can has been called once to check for init");
+$it = main::HBase3->new;
+is($CAN_COUNT, 1, "->can was not called again, we cached it");
+
+is($CAN_COUNT2, 0, "->can has not been called yet");
+is($INIT_COUNT, 0, "->init has not been called yet");
+$it = main::HBase4->new;
+is($CAN_COUNT2, 1, "->can has been called once to check for init");
+is($INIT_COUNT, 1, "->init has been called once");
+$it = main::HBase4->new;
+is($CAN_COUNT2, 1, "->can was not called again, we cached it");
+is($INIT_COUNT, 2, "->init has been called again");
+
done_testing;
1;
