Revision: 1169
Author: tim.bunce
Date: Fri Mar 12 02:35:37 2010
Log: Added Devel::NYTProf::Test::set_errno and used as probe in
t/50-errno.t.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1169
Modified:
/trunk/NYTProf.xs
/trunk/lib/Devel/NYTProf/Test.pm
/trunk/t/50-errno.t
=======================================
--- /trunk/NYTProf.xs Thu Mar 11 14:56:52 2010
+++ /trunk/NYTProf.xs Fri Mar 12 02:35:37 2010
@@ -4759,6 +4759,11 @@
*/
eval_pv("Devel::NYTProf::Test::example_xsub()", 1);
+void
+set_errno(int e)
+ CODE:
+ SETERRNO(e, 0);
+
MODULE = Devel::NYTProf PACKAGE = DB
=======================================
--- /trunk/lib/Devel/NYTProf/Test.pm Wed Jun 3 04:23:31 2009
+++ /trunk/lib/Devel/NYTProf/Test.pm Fri Mar 12 02:35:37 2010
@@ -8,7 +8,7 @@
require Exporter;
our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(example_sub example_xsub example_xsub_eval);
+our @EXPORT_OK = qw(example_sub example_xsub example_xsub_eval set_errno);
sub example_sub { }
=======================================
--- /trunk/t/50-errno.t Tue Feb 16 02:19:33 2010
+++ /trunk/t/50-errno.t Fri Mar 12 02:35:37 2010
@@ -6,9 +6,17 @@
$ENV{NYTPROF} = "start=init:file=$nytprof_out";
unlink $nytprof_out;
}
+
+use Devel::NYTProf::Test qw(example_xsub example_sub set_errno);
+
+BEGIN { # https://rt.cpan.org/Ticket/Display.html?id=55049
+ $! = 1; # set errno via perl
+ set_errno(2); # set errno via C-code in NYTProf.xs
+ return if $! == 2; # all is well
+ plan skip_all => "Can't control errno in this perl build (linked with
different CRT than perl?)";
+}
use Devel::NYTProf;
-use Devel::NYTProf::Test qw(example_xsub example_sub);
# We set errno to some particular non-zero value to see if NYTProf changes
it
# (on many unix-like systems 3 is ESRCH 'No such process')
@@ -19,7 +27,8 @@
is 0+$!, $dflterrno, '$! should not be altered by NYTProf';
my $size1 = -s $nytprof_out;
-cmp_ok $size1, '>=', 0, "$nytprof_out should exist";
+ok defined $size1, "$nytprof_out should at least exist"
+ or die "Can't continue: $!";
SKIP: {
skip 'On VMS buffer is not flushed', 1 if ($^O eq 'VMS');
--
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.
Group hosted at: http://groups.google.com/group/develnytprof-dev
Project hosted at: http://perl-devel-nytprof.googlecode.com
CPAN distribution: http://search.cpan.org/dist/Devel-NYTProf
To post, email: [email protected]
To unsubscribe, email: [email protected]
