add access to Perl_croak() via 'mycroak' in XS::APItest

p4raw-id: //depot/perl@24533

diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm
index 8c8491e..3794528 100644 (file)
--- a/ext/XS/APItest/APItest.pm
+++ b/ext/XS/APItest/APItest.pm
@@ -19,7 +19,7 @@ our @EXPORT = qw( print_double print_int print_long
                  call_sv call_pv call_method eval_sv eval_pv require_pv
                  G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
                  G_KEEPERR G_NODEBUG G_METHOD
-                 exception
+                 exception mycroak
 );
 
 # from cop.h 

diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index c562b98..db85db3 100644 (file)
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -333,3 +333,8 @@ exception(throw_e)
     OUTPUT:
         RETVAL
 
+void
+mycroak(pv)
+    const char* pv
+    CODE:
+    Perl_croak(aTHX_ "%s", pv);

diff --git a/ext/XS/APItest/t/exception.t b/ext/XS/APItest/t/exception.t
index c910f25..5341589 100644 (file)
--- a/ext/XS/APItest/t/exception.t
+++ b/ext/XS/APItest/t/exception.t
@@ -9,7 +9,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 8;
+use Test::More tests => 9;
 
 BEGIN { use_ok('XS::APItest') };
 
@@ -31,3 +31,6 @@ $rv = eval { exception(1) };
 is($@, "boo\n");
 ok(not defined $rv);
 is($XS::APItest::exception_caught, 1);
+
+$rv = eval { mycroak("foobar\n") };
+is($@, "foobar\n", 'croak');