In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/4e7fd22c88572020fe1efa67cd1781126f901d9e?hp=2485732a89bf5918fbda457cba014bb1b771356d>
- Log -----------------------------------------------------------------
commit 4e7fd22c88572020fe1efa67cd1781126f901d9e
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 17 09:40:49 2011 -0800
Add can_isa_ok.t to MANIFEST
M MANIFEST
commit bbce3ca648eab3f375216d4c9eba05cb6e005d05
Author: Michael G. Schwern <schw...@pobox.com>
Date: Tue Nov 15 17:39:07 2011 -0800
Add class_ok() and object_ok() to t/test.pl.
Change every existing instance of isa_ok() to use object_ok(). This is
safe because
before this point, t/test.pl's isa_ok() only worked on objects.
lib/dbmt_common.pl is
the last hold out because it uses Test::More.
These are like isa_ok() but they also check if it's a class or an object.
This lets the core tests defend against outlandish bugs while allowing
t/test.pl to retain feature parity with Test::More.
M t/lib/proxy_constant_subs.t
M t/mro/c3_with_overload.t
M t/mro/c3_with_overload_utf8.t
M t/mro/isa_c3.t
M t/mro/isa_c3_utf8.t
M t/mro/isa_dfs.t
M t/mro/isa_dfs_utf8.t
M t/mro/next_edgecases.t
M t/mro/next_edgecases_utf8.t
M t/mro/overload_c3.t
M t/mro/overload_c3_utf8.t
M t/mro/overload_dfs.t
M t/mro/package_aliases.t
M t/mro/package_aliases_utf8.t
M t/op/qr.t
M t/op/stash.t
M t/re/pat_advanced.t
M t/test.pl
M t/test_pl/can_isa_ok.t
M t/uni/stash.t
commit b8ab4b0c2ac8ae091a7ed7909f0d9b01ae5717f0
Author: Michael G. Schwern <schw...@pobox.com>
Date: Tue Nov 15 17:14:52 2011 -0800
Patch t/test.pl so isa_ok() works with objects.
This mirrors can_ok() and Test::More.
Also add some tests for isa_ok() and can_ok().
M t/test.pl
A t/test_pl/can_isa_ok.t
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
t/lib/proxy_constant_subs.t | 4 +-
t/mro/c3_with_overload.t | 4 +-
t/mro/c3_with_overload_utf8.t | 4 +-
t/mro/isa_c3.t | 2 +-
t/mro/isa_c3_utf8.t | 2 +-
t/mro/isa_dfs.t | 2 +-
t/mro/isa_dfs_utf8.t | 2 +-
t/mro/next_edgecases.t | 10 +++---
t/mro/next_edgecases_utf8.t | 10 +++---
t/mro/overload_c3.t | 4 +-
t/mro/overload_c3_utf8.t | 4 +-
t/mro/overload_dfs.t | 4 +-
t/mro/package_aliases.t | 4 +-
t/mro/package_aliases_utf8.t | 4 +-
t/op/qr.t | 16 +++++-----
t/op/stash.t | 6 ++--
t/re/pat_advanced.t | 2 +-
t/test.pl | 54 ++++++++++++++++++++++++++++++-----
t/test_pl/can_isa_ok.t | 63 +++++++++++++++++++++++++++++++++++++++++
t/uni/stash.t | 6 ++--
21 files changed, 155 insertions(+), 53 deletions(-)
create mode 100644 t/test_pl/can_isa_ok.t
diff --git a/MANIFEST b/MANIFEST
index fd89605..dc75cfe 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5346,6 +5346,7 @@ t/run/switchx.aux Data for switchx.t
t/run/switchx.t Test the -x switch
t/TEST The regression tester
t/test.pl Simple testing library
+t/test_pl/can_isa_ok.t Tests for the simple testing library
t/thread_it.pl Run regression tests in a new thread
t/uni/attrs.t See if Unicode attributes work
t/uni/bless.t See if Unicode bless works
diff --git a/t/lib/proxy_constant_subs.t b/t/lib/proxy_constant_subs.t
index e3cb41d..9e73006 100644
--- a/t/lib/proxy_constant_subs.t
+++ b/t/lib/proxy_constant_subs.t
@@ -23,10 +23,10 @@ foreach my $symbol (@symbols) {
$ps = svref_2object(\*{"Fcntl::$symbol"});
$ms = svref_2object(\*{"::$symbol"});
}
- isa_ok($ps, 'B::GV');
+ object_ok($ps, 'B::GV');
is($ps->GvFLAGS() & GVf_IMPORTED_CV, 0,
"GVf_IMPORTED_CV not set on original");
- isa_ok($ms, 'B::GV');
+ object_ok($ms, 'B::GV');
is($ms->GvFLAGS() & GVf_IMPORTED_CV, GVf_IMPORTED_CV,
"GVf_IMPORTED_CV set on imported GV");
}
diff --git a/t/mro/c3_with_overload.t b/t/mro/c3_with_overload.t
index 498ce2f..a75c31a 100644
--- a/t/mro/c3_with_overload.t
+++ b/t/mro/c3_with_overload.t
@@ -29,10 +29,10 @@ require q(./test.pl); plan(tests => 7);
}
my $x = InheritingFromOverloadedTest->new();
-isa_ok($x, 'InheritingFromOverloadedTest');
+object_ok($x, 'InheritingFromOverloadedTest');
my $y = OverloadingTest->new();
-isa_ok($y, 'OverloadingTest');
+object_ok($y, 'OverloadingTest');
is("$x", 'InheritingFromOverloadedTest stringified', '... got the right value
when stringifing');
is("$y", 'OverloadingTest stringified', '... got the right value when
stringifing');
diff --git a/t/mro/c3_with_overload_utf8.t b/t/mro/c3_with_overload_utf8.t
index 498ce2f..a75c31a 100644
--- a/t/mro/c3_with_overload_utf8.t
+++ b/t/mro/c3_with_overload_utf8.t
@@ -29,10 +29,10 @@ require q(./test.pl); plan(tests => 7);
}
my $x = InheritingFromOverloadedTest->new();
-isa_ok($x, 'InheritingFromOverloadedTest');
+object_ok($x, 'InheritingFromOverloadedTest');
my $y = OverloadingTest->new();
-isa_ok($y, 'OverloadingTest');
+object_ok($y, 'OverloadingTest');
is("$x", 'InheritingFromOverloadedTest stringified', '... got the right value
when stringifing');
is("$y", 'OverloadingTest stringified', '... got the right value when
stringifing');
diff --git a/t/mro/isa_c3.t b/t/mro/isa_c3.t
index 713d10e..dd129cf 100644
--- a/t/mro/isa_c3.t
+++ b/t/mro/isa_c3.t
@@ -64,6 +64,6 @@ foreach my $package (qw(klonk urkkk kapow kayo thwacke
zzzzzwap whamm)) {
is("@{mro::get_linear_isa($package)}", "@$isa", "\@ISA for $package");
foreach my $class ($package, @$isa, 'UNIVERSAL') {
- isa_ok($ref, $class, $package);
+ object_ok($ref, $class, $package);
}
}
diff --git a/t/mro/isa_c3_utf8.t b/t/mro/isa_c3_utf8.t
index 0e69e04..3e2e7a9 100644
--- a/t/mro/isa_c3_utf8.t
+++ b/t/mro/isa_c3_utf8.t
@@ -66,6 +66,6 @@ foreach my $package (qw(kà´oãḰ urá¸²á¸µï½ ìºoẠк
á¹íckÑ Å¹zzzá
is("@{mro::get_linear_isa($package)}", "@$isa", "\@ISA for $package");
foreach my $class ($package, @$isa, 'UNIVERSAL') {
- isa_ok($ref, $class, $package);
+ object_ok($ref, $class, $package);
}
}
diff --git a/t/mro/isa_dfs.t b/t/mro/isa_dfs.t
index 889ee6e..77c122e 100644
--- a/t/mro/isa_dfs.t
+++ b/t/mro/isa_dfs.t
@@ -60,6 +60,6 @@ foreach my $package (qw(klonk urkkk kapow kayo thwacke
zzzzzwap whamm)) {
is("@{mro::get_linear_isa($package)}", "@$isa", "\@ISA for $package");
foreach my $class ($package, @$isa, 'UNIVERSAL') {
- isa_ok($ref, $class, $package);
+ object_ok($ref, $class, $package);
}
}
diff --git a/t/mro/isa_dfs_utf8.t b/t/mro/isa_dfs_utf8.t
index b6608be..1c95eaa 100644
--- a/t/mro/isa_dfs_utf8.t
+++ b/t/mro/isa_dfs_utf8.t
@@ -62,6 +62,6 @@ foreach my $package (qw(kà´oãḰ urá¸²á¸µï½ ìºoẠк
á¹íckÑ Å¹zzzá
is("@{mro::get_linear_isa($package)}", "@$isa", "\@ISA for $package");
foreach my $class ($package, @$isa, 'UNIVERSAL') {
- isa_ok($ref, $class, $package);
+ object_ok($ref, $class, $package);
}
}
diff --git a/t/mro/next_edgecases.t b/t/mro/next_edgecases.t
index 7402ec9..e177d70 100644
--- a/t/mro/next_edgecases.t
+++ b/t/mro/next_edgecases.t
@@ -21,7 +21,7 @@ plan(tests => 12);
# call the submethod in the direct instance
my $foo = Foo->new();
- isa_ok($foo, 'Foo');
+ object_ok($foo, 'Foo');
can_ok($foo, 'bar');
is($foo->bar(), 'Foo::bar', '... got the right return value');
@@ -37,8 +37,8 @@ plan(tests => 12);
}
my $bar = Bar->new();
- isa_ok($bar, 'Bar');
- isa_ok($bar, 'Foo');
+ object_ok($bar, 'Bar');
+ object_ok($bar, 'Foo');
# test it working with with Sub::Name
SKIP: {
@@ -68,8 +68,8 @@ plan(tests => 12);
}
my $baz = Baz->new();
- isa_ok($baz, 'Baz');
- isa_ok($baz, 'Foo');
+ object_ok($baz, 'Baz');
+ object_ok($baz, 'Foo');
{
my $m = sub { (shift)->next::method() };
diff --git a/t/mro/next_edgecases_utf8.t b/t/mro/next_edgecases_utf8.t
index bd461c7..ba6ff8b 100644
--- a/t/mro/next_edgecases_utf8.t
+++ b/t/mro/next_edgecases_utf8.t
@@ -24,7 +24,7 @@ plan(tests => 12);
# call the submethod in the direct instance
my $foo = á->new();
- isa_ok($foo, 'á');
+ object_ok($foo, 'á');
can_ok($foo, 'Æ');
is($foo->Æ(), 'á::Æ', '... got the right return value');
@@ -40,8 +40,8 @@ plan(tests => 12);
}
my $bar = Baɾ->new();
- isa_ok($bar, 'Baɾ');
- isa_ok($bar, 'á');
+ object_ok($bar, 'Baɾ');
+ object_ok($bar, 'á');
# test it working with with Sub::Name
SKIP: {
@@ -71,8 +71,8 @@ plan(tests => 12);
}
my $baz = બÊ->new();
- isa_ok($baz, 'બÊ');
- isa_ok($baz, 'á');
+ object_ok($baz, 'બÊ');
+ object_ok($baz, 'á');
{
my $m = sub { (shift)->next::method() };
diff --git a/t/mro/overload_c3.t b/t/mro/overload_c3.t
index a62e631..db2b1ec 100644
--- a/t/mro/overload_c3.t
+++ b/t/mro/overload_c3.t
@@ -35,10 +35,10 @@ require q(./test.pl); plan(tests => 7);
}
my $x = InheritingFromOverloadedTest->new();
-isa_ok($x, 'InheritingFromOverloadedTest');
+object_ok($x, 'InheritingFromOverloadedTest');
my $y = OverloadingTest->new();
-isa_ok($y, 'OverloadingTest');
+object_ok($y, 'OverloadingTest');
is("$x", 'InheritingFromOverloadedTest stringified', '... got the right value
when stringifing');
is("$y", 'OverloadingTest stringified', '... got the right value when
stringifing');
diff --git a/t/mro/overload_c3_utf8.t b/t/mro/overload_c3_utf8.t
index 5a483ef..bcb9f70 100644
--- a/t/mro/overload_c3_utf8.t
+++ b/t/mro/overload_c3_utf8.t
@@ -38,10 +38,10 @@ require q(./test.pl); plan(tests => 7);
}
my $x = ìºÒêḮá¹áµ·ê°ë¡¬áµveÅÅoadìí
áµµ->ãá¹();
-isa_ok($x, 'ìºÒêḮá¹áµ·ê°ë¡¬áµveÅÅoadìí
áµµ');
+object_ok($x, 'ìºÒêḮá¹áµ·ê°ë¡¬áµveÅÅoadìí
áµµ');
my $y = Ovìrꪩà¡áï¼´eÅá¹±->ãá¹();
-isa_ok($y, 'Ovìrꪩà¡áï¼´eÅá¹±');
+object_ok($y, 'Ovìrꪩà¡áï¼´eÅá¹±');
is("$x", 'ìºÒêḮá¹áµ·ê°ë¡¬áµveÅÅoadìí
áµµ stringified', '... got
the right value when stringifing');
is("$y", 'Ovìrꪩà¡áï¼´eÅá¹± stringified', '... got the right value when
stringifing');
diff --git a/t/mro/overload_dfs.t b/t/mro/overload_dfs.t
index 89f11d0..5943c85 100644
--- a/t/mro/overload_dfs.t
+++ b/t/mro/overload_dfs.t
@@ -35,10 +35,10 @@ require q(./test.pl); plan(tests => 7);
}
my $x = InheritingFromOverloadedTest->new();
-isa_ok($x, 'InheritingFromOverloadedTest');
+object_ok($x, 'InheritingFromOverloadedTest');
my $y = OverloadingTest->new();
-isa_ok($y, 'OverloadingTest');
+object_ok($y, 'OverloadingTest');
is("$x", 'InheritingFromOverloadedTest stringified', '... got the right value
when stringifing');
is("$y", 'OverloadingTest stringified', '... got the right value when
stringifing');
diff --git a/t/mro/package_aliases.t b/t/mro/package_aliases.t
index b08e8ed..3bc3c8f 100644
--- a/t/mro/package_aliases.t
+++ b/t/mro/package_aliases.t
@@ -30,8 +30,8 @@ plan(tests => 52);
ok (Old->isa (New::), 'Old inherits from New');
ok (New->isa (Old::), 'New inherits from Old');
-isa_ok (bless ({}, Old::), New::, 'Old object');
-isa_ok (bless ({}, New::), Old::, 'New object');
+object_ok (bless ({}, Old::), New::, 'Old object');
+object_ok (bless ({}, New::), Old::, 'New object');
# Test that replacing a package by assigning to an existing glob
diff --git a/t/mro/package_aliases_utf8.t b/t/mro/package_aliases_utf8.t
index ae214e5..0106154 100644
--- a/t/mro/package_aliases_utf8.t
+++ b/t/mro/package_aliases_utf8.t
@@ -33,8 +33,8 @@ plan(tests => 52);
ok (à¤lã->isa(ï¼®eáº::), 'à¤lã inherits from ï¼®eáº');
ok (ï¼®eáº->isa(à¤lã::), 'ï¼®eẠinherits from à¤lã');
-isa_ok (bless ({}, à¤lã::), ï¼®eáº::, 'à¤lã object');
-isa_ok (bless ({}, ï¼®eáº::), à¤lã::, 'ï¼®eẠobject');
+object_ok (bless ({}, à¤lã::), ï¼®eáº::, 'à¤lã object');
+object_ok (bless ({}, ï¼®eáº::), à¤lã::, 'ï¼®eẠobject');
# Test that replacing a package by assigning to an existing glob
diff --git a/t/op/qr.t b/t/op/qr.t
index 13438de..90535d0 100644
--- a/t/op/qr.t
+++ b/t/op/qr.t
@@ -11,9 +11,9 @@ sub r {
}
my $a = r();
-isa_ok($a, 'Regexp');
+object_ok($a, 'Regexp');
my $b = r();
-isa_ok($b, 'Regexp');
+object_ok($b, 'Regexp');
my $b1 = $b;
@@ -21,9 +21,9 @@ isnt($a + 0, $b + 0, 'Not the same object');
bless $b, 'Pie';
-isa_ok($b, 'Pie');
-isa_ok($a, 'Regexp');
-isa_ok($b1, 'Pie');
+object_ok($b, 'Pie');
+object_ok($a, 'Regexp');
+object_ok($b1, 'Pie');
my $c = r();
like("$c", qr/Good/);
@@ -43,16 +43,16 @@ is($$d1, 'Bad');
# Assignment to an implicitly blessed Regexp object retains the class
# (No different from direct value assignment to any other blessed SV
-isa_ok($d, 'Regexp');
+object_ok($d, 'Regexp');
like("$d", qr/\ARegexp=SCALAR\(0x[0-9a-f]+\)\z/);
# As does an explicitly blessed Regexp object.
my $e = bless qr/Faux Pie/, 'Stew';
-isa_ok($e, 'Stew');
+object_ok($e, 'Stew');
$$e = 'Fake!';
is($$e, 'Fake!');
-isa_ok($e, 'Stew');
+object_ok($e, 'Stew');
like("$e", qr/\Stew=SCALAR\(0x[0-9a-f]+\)\z/);
diff --git a/t/op/stash.t b/t/op/stash.t
index e7d6609..9e223eb 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -92,7 +92,7 @@ SKIP: {
delete $one::{one};
my $gv = b($sub)->GV;
- isa_ok( $gv, "B::GV", "deleted stash entry leaves CV with valid GV");
+ object_ok( $gv, "B::GV", "deleted stash entry leaves CV with valid GV");
is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
is( eval { $gv->STASH->NAME }, "one", "...but leaves stash intact");
@@ -104,7 +104,7 @@ SKIP: {
%two:: = ();
$gv = b($sub)->GV;
- isa_ok( $gv, "B::GV", "cleared stash leaves CV with valid GV");
+ object_ok( $gv, "B::GV", "cleared stash leaves CV with valid GV");
is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
is( eval { $gv->STASH->NAME }, "two", "...but leaves stash intact");
@@ -116,7 +116,7 @@ SKIP: {
undef %three::;
$gv = b($sub)->GV;
- isa_ok( $gv, "B::GV", "undefed stash leaves CV with valid GV");
+ object_ok( $gv, "B::GV", "undefed stash leaves CV with valid GV");
is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
is( eval { $gv->STASH->NAME }, "__ANON__", "...and an __ANON__ stash");
diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index 6159b7b..4d88190 100644
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -2057,7 +2057,7 @@ EOP
(?<=[=&]) (?=.)
)}iox';
is($@, '', $message);
- isa_ok($r, 'Regexp', $message);
+ object_ok($r, 'Regexp', $message);
}
# RT #82610
diff --git a/t/test.pl b/t/test.pl
index 2fbde93..a287bc2 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -1064,7 +1064,7 @@ sub can_ok ($@) {
}
-# Call $class->new( @$args ); and run the result through isa_ok.
+# Call $class->new( @$args ); and run the result through object_ok.
# See Test::More::new_ok
sub new_ok {
my($class, $args, $obj_name) = @_;
@@ -1078,7 +1078,7 @@ sub new_ok {
my $error = $@;
if($ok) {
- isa_ok($obj, $class, $object_name);
+ object_ok($obj, $class, $object_name);
}
else {
ok( 0, "new() died" );
@@ -1099,20 +1099,29 @@ sub isa_ok ($$;$) {
if( !defined $object ) {
$diag = "$obj_name isn't defined";
}
- elsif( !ref $object ) {
- $diag = "$obj_name isn't a reference";
- }
else {
+ my $whatami = ref $object ? 'object' : 'class';
+
# We can't use UNIVERSAL::isa because we want to honor isa() overrides
local($@, $!); # eval sometimes resets $!
my $rslt = eval { $object->isa($class) };
- if( $@ ) {
- if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
+ my $error = $@; # in case something else blows away $@
+
+ if( $error ) {
+ if( $error =~ /^Can't call method "isa" on unblessed reference/ ) {
+ # It's an unblessed reference
+ $obj_name = 'The reference' unless defined $obj_name;
if( !UNIVERSAL::isa($object, $class) ) {
my $ref = ref $object;
$diag = "$obj_name isn't a '$class' it's a '$ref'";
}
- } else {
+ }
+ elsif( $error =~ /Can't call method "isa" without a package/ ) {
+ # It's something that can't even be a class
+ $obj_name = 'The thing' unless defined $obj_name;
+ $diag = "$obj_name isn't a class or reference";
+ }
+ else {
die <<WHOA;
WHOA! I tried to call ->isa on your object and got some weird error.
This should never happen. Please contact the author immediately.
@@ -1122,6 +1131,7 @@ WHOA
}
}
elsif( !$rslt ) {
+ $obj_name = "The $whatami" unless defined $obj_name;
my $ref = ref $object;
$diag = "$obj_name isn't a '$class' it's a '$ref'";
}
@@ -1130,6 +1140,34 @@ WHOA
_ok( !$diag, _where(), $name );
}
+
+sub class_ok {
+ my($class, $isa, $class_name) = @_;
+
+ # Written so as to count as one test
+ local $Level = $Level + 1;
+ if( ref $class ) {
+ ok( 0, "$class is a refrence, not a class name" );
+ }
+ else {
+ isa_ok($class, $isa, $class_name);
+ }
+}
+
+
+sub object_ok {
+ my($obj, $isa, $obj_name) = @_;
+
+ local $Level = $Level + 1;
+ if( !ref $obj ) {
+ ok( 0, "$obj is not a reference" );
+ }
+ else {
+ isa_ok($obj, $isa, $obj_name);
+ }
+}
+
+
# Purposefully avoiding a closure.
sub __capture {
push @::__capture, join "", @_;
diff --git a/t/test_pl/can_isa_ok.t b/t/test_pl/can_isa_ok.t
new file mode 100644
index 0000000..081d3e5
--- /dev/null
+++ b/t/test_pl/can_isa_ok.t
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl -w
+
+# Test isa_ok() and can_ok() in test.pl
+
+use strict;
+use warnings;
+
+BEGIN { require "test.pl"; }
+
+require Test::More;
+
+can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
+ pass fail eq_array eq_hash eq_set));
+can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip
+ can_ok pass fail eq_array eq_hash eq_set));
+
+
+isa_ok(bless([], "Foo"), "Foo");
+isa_ok([], 'ARRAY');
+isa_ok(\42, 'SCALAR');
+{
+ local %Bar::;
+ local @Foo::ISA = 'Bar';
+ isa_ok( "Foo", "Bar" );
+}
+
+
+# can_ok() & isa_ok should call can() & isa() on the given object, not
+# just class, in case of custom can()
+{
+ local *Foo::can;
+ local *Foo::isa;
+ *Foo::can = sub { $_[0]->[0] };
+ *Foo::isa = sub { $_[0]->[0] };
+ my $foo = bless([0], 'Foo');
+ ok( ! $foo->can('bar') );
+ ok( ! $foo->isa('bar') );
+ $foo->[0] = 1;
+ can_ok( $foo, 'blah');
+ isa_ok( $foo, 'blah');
+}
+
+
+note "object/class_ok"; {
+ {
+ package Child;
+ our @ISA = qw(Parent);
+ }
+
+ {
+ package Parent;
+ sub new { bless {}, shift }
+ }
+
+ # Unfortunately we can't usefully test the failure case without
+ # significantly modifying test.pl
+ class_ok "Child", "Parent";
+ class_ok "Parent", "Parent";
+ object_ok( Parent->new, "Parent" );
+ object_ok( Child->new, "Parent" );
+}
+
+done_testing;
diff --git a/t/uni/stash.t b/t/uni/stash.t
index f6e8c42..168b93c 100644
--- a/t/uni/stash.t
+++ b/t/uni/stash.t
@@ -84,7 +84,7 @@ plan( tests => 58 );
delete $ì¨êªµ::{ì¨êªµ};
my $gv = b($sub)->GV;
- isa_ok( $gv, "B::GV", "deleted stash entry leaves CV with valid GV");
+ object_ok( $gv, "B::GV", "deleted stash entry leaves CV with valid
GV");
is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
is( eval { $gv->STASH->NAME }, "ì¨êªµ", "...but leaves stash intact");
@@ -96,7 +96,7 @@ plan( tests => 58 );
%tê¿:: = ();
$gv = b($sub)->GV;
- isa_ok( $gv, "B::GV", "cleared stash leaves CV with valid GV");
+ object_ok( $gv, "B::GV", "cleared stash leaves CV with valid GV");
is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
is( eval { $gv->STASH->NAME }, "tê¿", "...but leaves stash intact");
@@ -108,7 +108,7 @@ plan( tests => 58 );
undef %áë ï¿::;
$gv = b($sub)->GV;
- isa_ok( $gv, "B::GV", "undefed stash leaves CV with valid GV");
+ object_ok( $gv, "B::GV", "undefed stash leaves CV with valid GV");
is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
is( eval { $gv->STASH->NAME }, "__ANON__", "...and an __ANON__ stash");
--
Perl5 Master Repository
