Change 17823 by rgs@rgs-home on 2002/09/03 19:47:05
Fix bug #16828.
Add a few tests to ext/B/t/b.t, make it use Test::More.
Affected files ...
.... //depot/perl/ext/B/B.xs#77 edit
.... //depot/perl/ext/B/t/b.t#2 edit
Differences ...
==== //depot/perl/ext/B/B.xs#77 (text) ====
Index: perl/ext/B/B.xs
--- perl/ext/B/B.xs#76~17804~ Thu Aug 29 06:29:43 2002
+++ perl/ext/B/B.xs Tue Sep 3 12:47:05 2002
@@ -1077,6 +1077,15 @@
B::MAGIC
MgMOREMAGIC(mg)
B::MAGIC mg
+ CODE:
+ if( MgMOREMAGIC(mg) ) {
+ RETVAL = MgMOREMAGIC(mg);
+ }
+ else {
+ XSRETURN_UNDEF;
+ }
+ OUTPUT:
+ RETVAL
U16
MgPRIVATE(mg)
==== //depot/perl/ext/B/t/b.t#2 (xtext) ====
Index: perl/ext/B/t/b.t
--- perl/ext/B/t/b.t#1~12256~ Fri Sep 28 05:18:29 2001
+++ perl/ext/B/t/b.t Tue Sep 3 12:47:05 2002
@@ -13,15 +13,9 @@
$| = 1;
use warnings;
use strict;
-use Config;
+use Test::More tests => 5;
-print "1..2\n";
-
-my $test = 1;
-
-sub ok { print "ok $test\n"; $test++ }
-
-use B;
+BEGIN { use_ok( 'B' ); }
package Testing::Symtable;
@@ -55,9 +49,18 @@
push @syms, "Testing::Symtable::Foo::yarrow";
# Make sure we hit all the expected symbols.
-print "not " unless join('', sort @syms) eq join('', sort keys %Subs);
-ok;
+ok( join('', sort @syms) eq join('', sort keys %Subs), 'all symbols found' );
# Make sure we only hit them each once.
-print "not " unless !grep $_ != 1, values %Subs;
-ok;
+ok( (!grep $_ != 1, values %Subs), '...and found once' );
+
+# Tests for MAGIC / MOREMAGIC
+ok( B::svref_2object(\$.)->MAGIC->TYPE eq "\0", '$. has \0 magic' );
+{
+ my $e = '';
+ local $SIG{__DIE__} = sub { $e = $_[0] };
+ # Used to dump core, bug #16828
+ eval { B::svref_2object(\$.)->MAGIC->MOREMAGIC->TYPE; };
+ like( $e, qr/Can't call method "TYPE" on an undefined value/,
+ '$. has no more magic' );
+}
End of Patch.
