Fix bug #16828.

Add a few tests to ext/B/t/b.t, make it use Test::More.

p4raw-id: //depot/perl@17823

diff --git a/ext/B/B.xs b/ext/B/B.xs
index d7ae0f1..c9ce77c 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1077,6 +1077,15 @@ MODULE = B       PACKAGE = B::MAGIC      PREFIX = Mg
 B::MAGIC
 MgMOREMAGIC(mg)
        B::MAGIC        mg
+     CODE:
+       if( MgMOREMAGIC(mg) ) {
+           RETVAL = MgMOREMAGIC(mg);
+       }
+       else {
+           XSRETURN_UNDEF;
+       }
+     OUTPUT:
+       RETVAL
 
 U16
 MgPRIVATE(mg)

diff --git a/ext/B/t/b.t b/ext/B/t/b.t
index f21f489..45250e2 100755 (executable)
--- a/ext/B/t/b.t
+++ b/ext/B/t/b.t
@@ -13,15 +13,9 @@ BEGIN {
 $|  = 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 @@ my @syms = map { 'Testing::Symtable::'.$_ } qw(This That wibble moo car
 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' );
+}