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.

Reply via email to