Upgrade Test-Simple to 1.302071.

[perl5.git] / cpan / Test-Simple / t / Test2 / modules / Util / HashBase.t

diff --git a/cpan/Test-Simple/t/Test2/modules/Util/HashBase.t b/cpan/Test-Simple/t/Test2/modules/Util/HashBase.t
index 0e81e9f..7f1824a 100644 (file)
--- a/cpan/Test-Simple/t/Test2/modules/Util/HashBase.t
+++ b/cpan/Test-Simple/t/Test2/modules/Util/HashBase.t
@@ -1,10 +1,30 @@
 use strict;
 use warnings;
-BEGIN { require "t/tools.pl" };
+
+use Test::More;
+
+
+sub warnings(&) {
+    my $code = shift;
+    my @warnings;
+    local $SIG{__WARN__} = sub { push @warnings => @_ };
+    $code->();
+    return \@warnings;
+}
+
+sub exception(&) {
+    my $code = shift;
+    local ($@, $!, $SIG{__DIE__});
+    my $ok = eval { $code->(); 1 };
+    my $error = $@ || 'SQUASHED ERROR';
+    return $ok ? undef : $error;
+}
+
 BEGIN {
-    $INC{'My/HBase.pm'} = __FILE__;
+    $INC{'Object/HashBase/Test/HBase.pm'} = __FILE__;
 
-    package My::HBase;
+    package
+        main::HBase;
     use Test2::Util::HashBase qw/foo bar baz/;
 
     main::is(FOO, 'foo', "FOO CONSTANT");
@@ -13,8 +33,9 @@ BEGIN {
 }
 
 BEGIN {
-    package My::HBaseSub;
-    use base 'My::HBase';
+    package
+        main::HBaseSub;
+    use base 'main::HBase';
     use Test2::Util::HashBase qw/apple pear/;
 
     main::is(FOO,   'foo',   "FOO CONSTANT");
@@ -24,7 +45,7 @@ BEGIN {
     main::is(PEAR,  'pear',  "PEAR CONSTANT");
 }
 
-my $one = My::HBase->new(foo => 'a', bar => 'b', baz => 'c');
+my $one = main::HBase->new(foo => 'a', bar => 'b', baz => 'c');
 is($one->foo, 'a', "Accessor");
 is($one->bar, 'b', "Accessor");
 is($one->baz, 'c', "Accessor");
@@ -43,7 +64,8 @@ is_deeply(
 );
 
 BEGIN {
-    package My::Const::Test;
+    package
+        main::Const::Test;
     use Test2::Util::HashBase qw/foo/;
 
     sub do_it {
@@ -54,19 +76,20 @@ BEGIN {
     }
 }
 
-my $pkg = 'My::Const::Test';
+my $pkg = 'main::Const::Test';
 is($pkg->do_it, 'const', "worked as expected");
 {
     local $SIG{__WARN__} = sub { };
-    *My::Const::Test::FOO = sub { 0 };
+    *main::Const::Test::FOO = sub { 0 };
 }
 ok(!$pkg->FOO, "overrode const sub");
 is($pkg->do_it, 'const', "worked as expected, const was constant");
 
 BEGIN {
-    $INC{'My/HBase/Wrapped.pm'} = __FILE__;
+    $INC{'Object/HashBase/Test/HBase/Wrapped.pm'} = __FILE__;
 
-    package My::HBase::Wrapped;
+    package
+        main::HBase::Wrapped;
     use Test2::Util::HashBase qw/foo bar/;
 
     my $foo = __PACKAGE__->can('foo');
@@ -79,19 +102,21 @@ BEGIN {
 }
 
 BEGIN {
-    $INC{'My/HBase/Wrapped/Inherit.pm'} = __FILE__;
+    $INC{'Object/HashBase/Test/HBase/Wrapped/Inherit.pm'} = __FILE__;
 
-    package My::HBase::Wrapped::Inherit;
-    use base 'My::HBase::Wrapped';
+    package
+        main::HBase::Wrapped::Inherit;
+    use base 'main::HBase::Wrapped';
     use Test2::Util::HashBase;
 }
 
-my $o = My::HBase::Wrapped::Inherit->new(foo => 1);
+my $o = main::HBase::Wrapped::Inherit->new(foo => 1);
 my $foo = $o->foo;
 is($o->bar, 1, 'parent attribute sub not overridden');
 
 {
-    package Foo;
+    package
+        Foo;
 
     sub new;
 
@@ -102,4 +127,31 @@ is($o->bar, 1, 'parent attribute sub not overridden');
 
 is(Foo->new, 'foo', "Did not override existing 'new' method");
 
+BEGIN {
+    $INC{'Object/HashBase/Test/HBase2.pm'} = __FILE__;
+
+    package
+        main::HBase2;
+    use Test2::Util::HashBase qw/foo -bar ^baz/;
+
+    main::is(FOO, 'foo', "FOO CONSTANT");
+    main::is(BAR, 'bar', "BAR CONSTANT");
+    main::is(BAZ, 'baz', "BAZ CONSTANT");
+}
+
+my $ro = main::HBase2->new(foo => 'foo', bar => 'bar', baz => 'baz');
+is($ro->foo, 'foo', "got foo");
+is($ro->bar, 'bar', "got bar");
+is($ro->baz, 'baz', "got baz");
+
+is($ro->set_foo('xxx'), 'xxx', "Can set foo");
+is($ro->foo, 'xxx', "got foo");
+
+like(exception { $ro->set_bar('xxx') }, qr/'bar' is read-only/, "Cannot set bar");
+
+my $warnings = warnings { is($ro->set_baz('xxx'), 'xxx', 'set baz') };
+like($warnings->[0], qr/set_baz\(\) is deprecated/, "Deprecation warning");
+
 done_testing;
+
+1;