diff options
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/Time/HiRes/Changes | 21 | ||||
| -rw-r--r-- | ext/Time/HiRes/HiRes.pm | 12 | ||||
| -rw-r--r-- | ext/Time/HiRes/HiRes.xs | 78 | ||||
| -rw-r--r-- | ext/Time/HiRes/Makefile.PL | 160 | ||||
| -rw-r--r-- | ext/Time/HiRes/fallback/const-c.inc | 202 | ||||
| -rw-r--r-- | ext/Time/HiRes/fallback/const-xs.inc | 88 |
6 files changed, 428 insertions, 133 deletions
diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index 2340fb558a..971e7012e3 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,5 +1,26 @@ Revision history for Perl extension Time::HiRes. +1.42 + - modernize the constants code (from Nicholas Clark) + +1.41 + - At some point the ability to figure our the correct incdir + for EXTERN.h (either a core perl build, or an installed perl) + had broken (which lead into all test compiles failing with + a core perl build, but thanks to the robustness of Makefile.PL + nothing of was visible). The brokenness seemed to be caused + by $ENV{PERL_CORE} not being on for core builds? Now stole + a trick from the Encode that sets $ENV{PERL_CORE} right, and + both styles of build should work again. + +1.40 + - Nicholas Clark noticed that the my_catdir() emulation function + was broken (which means that we didn't really work for Perls + 5.002 and 5.003) + - inspired by fixing the above made the whole Makefile.PL -w + and strict clean + - tightened up the Makefile.PL output, less whitespace + 1.39 - fix from Craig Berry for better building in VMS with PERL_CORE diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index 532484e414..ffa010b2a5 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -15,18 +15,16 @@ require DynaLoader; d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep); -$VERSION = '1.39'; +$VERSION = '1.42'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; sub AUTOLOAD { my $constname; - ($constname= $AUTOLOAD) =~ s/.*:://; - my $val = constant($constname, @_ ? $_[0] : 0); - if ($!) { - my ($pack,$file,$line) = caller; - die "Your vendor has not defined Time::HiRes macro $constname, used at $file line $line.\n"; - } + ($constname = $AUTOLOAD) =~ s/.*:://; + die "&Time::HiRes::constant not defined" if $constname eq 'constant'; + my ($error, $val) = constant($constname); + if ($error) { die $error; } { no strict 'refs'; *$AUTOLOAD = sub { $val }; diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index 5da54c6d19..560cb3db48 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -98,77 +98,14 @@ sv_2pv_nolen(pTHX_ register SV *sv) # undef ITIMER_REALPROF #endif -static IV -constant(char *name, int arg) -{ - errno = 0; - switch (*name) { - case 'd': - if (strEQ(name, "d_getitimer")) -#ifdef HAS_GETITIMER - return 1; -#else - return 0; -#endif - if (strEQ(name, "d_nanosleep")) -#ifdef HAS_NANOSLEEP - return 1; -#else - return 0; -#endif - if (strEQ(name, "d_setitimer")) -#ifdef HAS_SETITIMER - return 1; -#else - return 0; -#endif - if (strEQ(name, "d_ualarm")) -#ifdef HAS_UALARM - return 1; -#else - return 0; -#endif - if (strEQ(name, "d_usleep")) -#ifdef HAS_USLEEP - return 1; -#else - return 0; +/* 5.004 doesn't define PL_sv_undef */ +#ifndef ATLEASTFIVEOHOHFIVE +#ifndef PL_sv_undef +#define PL_sv_undef sv_undef #endif - break; - case 'I': - if (strEQ(name, "ITIMER_REAL")) -#ifdef ITIMER_REAL - return ITIMER_REAL; -#else - goto not_there; -#endif - if (strEQ(name, "ITIMER_REALPROF")) -#ifdef ITIMER_REALPROF - return ITIMER_REALPROF; -#else - goto not_there; #endif - if (strEQ(name, "ITIMER_VIRTUAL")) -#ifdef ITIMER_VIRTUAL - return ITIMER_VIRTUAL; -#else - goto not_there; -#endif - if (strEQ(name, "ITIMER_PROF")) -#ifdef ITIMER_PROF - return ITIMER_PROF; -#else - goto not_there; -#endif - break; - } - errno = EINVAL; - return 0; -not_there: - errno = ENOENT; - return 0; -} +#include "const-c.inc" #if !defined(HAS_GETTIMEOFDAY) && defined(WIN32) #define HAS_GETTIMEOFDAY @@ -699,10 +636,7 @@ BOOT: #endif #endif -IV -constant(name, arg) - char * name - int arg +INCLUDE: const-xs.inc #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL index 586823984f..50b98bafe9 100644 --- a/ext/Time/HiRes/Makefile.PL +++ b/ext/Time/HiRes/Makefile.PL @@ -7,10 +7,18 @@ require 5.002; use Config; use ExtUtils::MakeMaker; - -# Perls 5.002 and 5.003 did not have File::Spec, fake what we need. +use strict; my $VERBOSE = $ENV{VERBOSE}; +my $DEFINE; +my $LIBS; +my $XSOPT; + +unless($ENV{PERL_CORE}) { # This trick from Encode/Makefile.PL. + $ENV{PERL_CORE} = 1 if ($^X =~ m{\bminiperl[^/\\\]>:]*$}o); +} + +# Perls 5.002 and 5.003 did not have File::Spec, fake what we need. sub my_dirsep { $^O eq 'VMS' ? '.' : @@ -22,7 +30,14 @@ sub my_dirsep { sub my_catdir { shift; my $catdir = join(my_dirsep, @_); - $^O eq 'VMS' ? "[$dirsep]" : $dirsep; + $^O eq 'VMS' ? "[$catdir]" : $catdir; +} + +sub my_catfile { + shift; + return join(my_dirsep, @_) unless $^O eq 'VMS'; + my $file = pop; + return my_catdir (undef, @_) . $file; } sub my_updir { @@ -35,9 +50,15 @@ BEGIN { if ($@) { *File::Spec::catdir = \&my_catdir; *File::Spec::updir = \&my_updir; + *File::Spec::catfile = \&my_catfile; } } +# Avoid 'used only once' warnings. +my $nop1 = *File::Spec::catdir; +my $nop2 = *File::Spec::updir; +my $nop3 = *File::Spec::catfile; + # if you have 5.004_03 (and some slightly older versions?), xsubpp # tries to generate line numbers in the C code generated from the .xs. # unfortunately, it is a little buggy around #ifdef'd code. @@ -50,8 +71,7 @@ sub TMPDIR { my $TMPDIR = (grep(defined $_ && -d $_ && -w _, ((defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : undef), - qw(/var/tmp /usr/tmp /tmp))))[0] - unless defined $TMPDIR; + qw(/var/tmp /usr/tmp /tmp))))[0]; $TMPDIR || die "Cannot find writable temporary directory.\n"; } @@ -59,7 +79,7 @@ sub try_compile_and_link { my ($c, %args) = @_; my ($ok) = 0; - my ($tmp) = (($^O eq 'VMS') ? "sys\$scratch:tmp$$" : TMPDIR . '/' . "tmp$$"); + my ($tmp) = (($^O eq 'VMS') ? "sys\$scratch:tmp$$" : TMPDIR() . '/' . "tmp$$"); local(*TMPC); my $obj_ext = $Config{obj_ext} || ".o"; @@ -69,18 +89,21 @@ sub try_compile_and_link { print TMPC $c; close(TMPC); - $cccmd = $args{cccmd}; + my $cccmd = $args{cccmd}; my $errornull; my $COREincdir; + if ($ENV{PERL_CORE}) { my $updir = File::Spec->updir; $COREincdir = File::Spec->catdir(($updir) x 3); } else { $COREincdir = File::Spec->catdir($Config{'archlibexp'}, 'CORE'); } + my $ccflags = $Config{'ccflags'} . ' ' . "-I$COREincdir"; + if ($^O eq 'VMS') { if ($ENV{PERL_CORE}) { # Fragile if the extensions change hierachy within @@ -89,7 +112,7 @@ sub try_compile_and_link { } else { my $perl_core = $Config{'installarchlib'}; $perl_core =~ s/\]$/.CORE]/; - $cccmd = "$Config{'cc'} /include=(perl_root:[000000],$perl_core) $tmp.c"; + $cccmd = "$Config{'cc'} /include=(perl_root:[000000],$perl_core) $tmp.c"; } } @@ -99,18 +122,19 @@ sub try_compile_and_link { $errornull = ''; } - $cccmd = "$Config{'cc'} -o $tmp $ccflags $tmp.c @$LIBS $errornull" + $cccmd = "$Config{'cc'} -o $tmp $ccflags $tmp.c @$LIBS $errornull" unless defined $cccmd; + if ($^O eq 'VMS') { open( CMDFILE, ">$tmp.com" ); print CMDFILE "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n"; print CMDFILE "\$ $cccmd\n"; - print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate + print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate close CMDFILE; system("\@ $tmp.com"); $ok = $?==0; for ("$tmp.c", "$tmp$obj_ext", "$tmp.com", "$tmp$Config{exe_ext}") { - 1 while unlink $_; + 1 while unlink $_; } } else @@ -128,7 +152,7 @@ sub try_compile_and_link { sub has_gettimeofday { # confusing but true (if condition true ==> -DHAS_GETTIMEOFDAY already) return 0 if $Config{'d_gettimeod'} eq 'define'; - return 1 if try_compile_and_link(<<EOM); + return 1 if try_compile_and_link(<<EOM); #include "EXTERN.h" #include "perl.h" #include "XSUB.h" @@ -157,7 +181,7 @@ EOM } sub has_x { - my ($x, %args) = @_; + my ($x, %args) = @_; return 1 if try_compile_and_link(<<EOM, %args); @@ -206,24 +230,27 @@ sub unixinit { my @goodlibs; - select(STDOUT); $| = 1; + select(STDOUT); + $| = 1; print "Checking for libraries...\n"; my $lib; for $lib (@$LIBS) { - print "Checking for $lib...\n"; + print "Checking for $lib... "; $LIBS = [ $lib ]; if ($Config{libs} =~ /\b$lib\b/ || has_x("time(0)")) { push @goodlibs, $lib; + print "found.\n"; + } else { + print "NOT found.\n"; } } - @$LIBS = @goodlibs; + $LIBS = [ @goodlibs ]; print @$LIBS ? "You have extra libraries: @$LIBS.\n" : "You have no applicable extra libraries.\n"; - print "\n"; - print "Looking for gettimeofday()...\n"; + print "Looking for gettimeofday()... "; my $has_gettimeofday; if ($Config{'d_gettimeod'}) { $has_gettimeofday++; @@ -233,7 +260,7 @@ sub unixinit { } if ($has_gettimeofday) { - print "You have gettimeofday().\n\n"; + print "found.\n"; } else { die <<EOD Your operating system does not seem to have the gettimeofday() function. @@ -248,7 +275,7 @@ Aborting configuration. EOD } - print "Looking for setitimer()...\n"; + print "Looking for setitimer()... "; my $has_setitimer; if ($Config{d_setitimer}) { $has_setitimer++; @@ -258,12 +285,12 @@ EOD } if ($has_setitimer) { - print "You have setitimer().\n\n"; + print "found.\n"; } else { - print "No setitimer().\n\n"; + print "NOT found.\n"; } - print "Looking for getitimer()...\n"; + print "Looking for getitimer()... "; my $has_getitimer; if ($Config{d_getitimer}) { $has_getitimer++; @@ -273,19 +300,19 @@ EOD } if ($has_getitimer) { - print "You have getitimer().\n\n"; + print "found.\n"; } else { - print "No getitimer().\n\n"; + print "NOT found.\n"; } if ($has_setitimer && $has_getitimer) { - print "You have interval timers (both setitimer and setitimer).\n\n"; + print "You have interval timers (both setitimer and setitimer).\n"; } else { - print "You do not have interval timers.\n\n"; + print "You do not have interval timers.\n"; } - print "Looking for ualarm()...\n"; - my $has_ualarm; + print "Looking for ualarm()... "; + my $has_ualarm; if ($Config{d_ualarm}) { $has_ualarm++; } elsif (has_x ("ualarm (0, 0)")) { @@ -294,17 +321,16 @@ EOD } if ($has_ualarm) { - print "You have ualarm().\n\n"; + print "found.\n"; } else { - print "Whoops! No ualarm()!\n"; - if ($setitimer) { - print "You have setitimer(); we can make a Time::HiRes::ualarm()\n\n"; - } else { - print "We'll manage.\n\n"; + print "NOT found.\n"; + if ($has_setitimer) { + print "But you have setitimer().\n"; + print "We can make a Time::HiRes::ualarm().\n"; } } - print "Looking for usleep()...\n"; + print "Looking for usleep()... "; my $has_usleep; if ($Config{d_usleep}) { $has_usleep++; @@ -314,17 +340,20 @@ EOD } if ($has_usleep) { - print "You have usleep().\n\n"; + print "found.\n"; } else { - print "Whoops! No usleep()! Let's see if you have select().\n"; + print "NOT found.\n"; + print "Let's see if you have select()... "; if ($Config{'d_select'} eq 'define') { - print "You have select(); we can make a Time::HiRes::usleep()\n\n"; + print "found.\n"; + print "We can make a Time::HiRes::usleep().\n"; } else { - print "No select(); you won't have a Time::HiRes::usleep()\n\n"; + print "NOT found.\n"; + print "You won't have a Time::HiRes::usleep().\n"; } } - print "Looking for nanosleep()...\n"; + print "Looking for nanosleep()... "; my $has_nanosleep; if ($Config{d_nanosleep}) { $has_nanosleep++; @@ -334,9 +363,11 @@ EOD } if ($has_nanosleep) { - print "You have nanosleep(). You can mix subsecond sleeps with signals.\n\n"; + print "found.\n"; + print "You can mix subsecond sleeps with signals.\n"; } else { - print "Whoops! No nanosleep()! You cannot mix subsecond sleeps with signals.\n"; + print "NOT found.\n"; + print "You cannot mix subsecond sleeps with signals.\n"; } if ($DEFINE) { @@ -349,7 +380,7 @@ EOD } sub doMakefile { - @makefileopts = (); + my @makefileopts = (); if ($] >= 5.005) { push (@makefileopts, @@ -374,17 +405,42 @@ sub doMakefile { 'SUFFIX' => 'gz', }, clean => { FILES => "xdefine" }, + realclean => {FILES=> 'const-c.inc const-xs.inc'}, ); WriteMakefile(@makefileopts); } -sub main { - print <<EOM; - -Configuring Time::HiRes... +sub doConstants { + if (eval {require ExtUtils::Constant; 1}) { + my @names = (qw(ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF + ITIMER_REALPROF)); + foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer + d_nanosleep)) { + my $macro = $_; + $macro =~ s/d_(.*)/HAS_\U$1/; + push @names, {name => $_, macro => $macro, value => 1, + default => ["IV", "0"]}; + } + ExtUtils::Constant::WriteConstants( + NAME => 'Time::HiRes', + NAMES => \@names, + ); + } else { + foreach my $file ('const-c.inc', 'const-xs.inc') { + my $fallback = File::Spec->catfile('fallback', $file); + local $/; + open IN, "<$fallback" or die "Can't open $fallback: $!"; + open OUT, ">$file" or die "Can't open $file: $!"; + print OUT <IN> or die $!; + close OUT or die "Can't close $file: $!"; + close IN or die "Can't close $fallback: $!"; + } + } +} -EOM +sub main { + print "Configuring Time::HiRes...\n"; if ($^O =~ /Win32/i) { $DEFINE = '-DSELECT_IS_BROKEN'; @@ -392,16 +448,12 @@ EOM } else { unixinit(); } - configure; doMakefile; + doConstants; my $make = $Config{'make'} || "make"; unless ($ENV{PERL_CORE}) { print <<EOM; - -Done configuring. - Now you may issue '$make'. Do not forget also '$make test'. - EOM } } diff --git a/ext/Time/HiRes/fallback/const-c.inc b/ext/Time/HiRes/fallback/const-c.inc new file mode 100644 index 0000000000..77b137f632 --- /dev/null +++ b/ext/Time/HiRes/fallback/const-c.inc @@ -0,0 +1,202 @@ +#define PERL_constant_NOTFOUND 1 +#define PERL_constant_NOTDEF 2 +#define PERL_constant_ISIV 3 +#define PERL_constant_ISNO 4 +#define PERL_constant_ISNV 5 +#define PERL_constant_ISPV 6 +#define PERL_constant_ISPVN 7 +#define PERL_constant_ISSV 8 +#define PERL_constant_ISUNDEF 9 +#define PERL_constant_ISUV 10 +#define PERL_constant_ISYES 11 + +#ifndef NVTYPE +typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ +#endif +#ifndef aTHX_ +#define aTHX_ /* 5.6 or later define this for threading support. */ +#endif +#ifndef pTHX_ +#define pTHX_ /* 5.6 or later define this for threading support. */ +#endif + +static int +constant_11 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + ITIMER_PROF ITIMER_REAL d_getitimer d_nanosleep d_setitimer */ + /* Offset 7 gives the best switch position. */ + switch (name[7]) { + case 'P': + if (memEQ(name, "ITIMER_PROF", 11)) { + /* ^ */ +#ifdef ITIMER_PROF + *iv_return = ITIMER_PROF; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "ITIMER_REAL", 11)) { + /* ^ */ +#ifdef ITIMER_REAL + *iv_return = ITIMER_REAL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'i': + if (memEQ(name, "d_getitimer", 11)) { + /* ^ */ +#ifdef HAS_GETITIMER + *iv_return = 1; + return PERL_constant_ISIV; +#else + *iv_return = 0; + return PERL_constant_ISIV; +#endif + } + if (memEQ(name, "d_setitimer", 11)) { + /* ^ */ +#ifdef HAS_SETITIMER + *iv_return = 1; + return PERL_constant_ISIV; +#else + *iv_return = 0; + return PERL_constant_ISIV; +#endif + } + break; + case 'l': + if (memEQ(name, "d_nanosleep", 11)) { + /* ^ */ +#ifdef HAS_NANOSLEEP + *iv_return = 1; + return PERL_constant_ISIV; +#else + *iv_return = 0; + return PERL_constant_ISIV; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant (pTHX_ const char *name, STRLEN len, IV *iv_return) { + /* Initially switch on the length of the name. */ + /* When generated this function returned values for the list of names given + in this section of perl code. Rather than manually editing these functions + to add or remove constants, which would result in this comment and section + of code becoming inaccurate, we recommend that you edit this section of + code, and use it to regenerate a new set of constant functions which you + then use to replace the originals. + + Regenerate these constant functions by feeding this entire source file to + perl -x + +#!/usr/local/bin/perl5.8.0 -w +use ExtUtils::Constant qw (constant_types C_constant XS_constant); + +my $types = {map {($_, 1)} qw(IV)}; +my @names = (qw(ITIMER_PROF ITIMER_REAL ITIMER_REALPROF ITIMER_VIRTUAL), + {name=>"d_getitimer", type=>"IV", macro=>"HAS_GETITIMER", value=>"1", default=>["IV", "0"]}, + {name=>"d_gettimeofday", type=>"IV", macro=>"HAS_GETTIMEOFDAY", value=>"1", default=>["IV", "0"]}, + {name=>"d_nanosleep", type=>"IV", macro=>"HAS_NANOSLEEP", value=>"1", default=>["IV", "0"]}, + {name=>"d_setitimer", type=>"IV", macro=>"HAS_SETITIMER", value=>"1", default=>["IV", "0"]}, + {name=>"d_ualarm", type=>"IV", macro=>"HAS_UALARM", value=>"1", default=>["IV", "0"]}, + {name=>"d_usleep", type=>"IV", macro=>"HAS_USLEEP", value=>"1", default=>["IV", "0"]}); + +print constant_types(); # macro defs +foreach (C_constant ("Time::HiRes", 'constant', 'IV', $types, undef, 3, @names) ) { + print $_, "\n"; # C constant subs +} +print "#### XS Section:\n"; +print XS_constant ("Time::HiRes", $types); +__END__ + */ + + switch (len) { + case 8: + /* Names all of length 8. */ + /* d_ualarm d_usleep */ + /* Offset 7 gives the best switch position. */ + switch (name[7]) { + case 'm': + if (memEQ(name, "d_ualarm", 8)) { + /* ^ */ +#ifdef HAS_UALARM + *iv_return = 1; + return PERL_constant_ISIV; +#else + *iv_return = 0; + return PERL_constant_ISIV; +#endif + } + break; + case 'p': + if (memEQ(name, "d_usleep", 8)) { + /* ^ */ +#ifdef HAS_USLEEP + *iv_return = 1; + return PERL_constant_ISIV; +#else + *iv_return = 0; + return PERL_constant_ISIV; +#endif + } + break; + } + break; + case 11: + return constant_11 (aTHX_ name, iv_return); + break; + case 14: + /* Names all of length 14. */ + /* ITIMER_VIRTUAL d_gettimeofday */ + /* Offset 6 gives the best switch position. */ + switch (name[6]) { + case '_': + if (memEQ(name, "ITIMER_VIRTUAL", 14)) { + /* ^ */ +#ifdef ITIMER_VIRTUAL + *iv_return = ITIMER_VIRTUAL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'i': + if (memEQ(name, "d_gettimeofday", 14)) { + /* ^ */ +#ifdef HAS_GETTIMEOFDAY + *iv_return = 1; + return PERL_constant_ISIV; +#else + *iv_return = 0; + return PERL_constant_ISIV; +#endif + } + break; + } + break; + case 15: + if (memEQ(name, "ITIMER_REALPROF", 15)) { +#ifdef ITIMER_REALPROF + *iv_return = ITIMER_REALPROF; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + diff --git a/ext/Time/HiRes/fallback/const-xs.inc b/ext/Time/HiRes/fallback/const-xs.inc new file mode 100644 index 0000000000..c84dd051dd --- /dev/null +++ b/ext/Time/HiRes/fallback/const-xs.inc @@ -0,0 +1,88 @@ +void +constant(sv) + PREINIT: +#ifdef dXSTARG + dXSTARG; /* Faster if we have it. */ +#else + dTARGET; +#endif + STRLEN len; + int type; + IV iv; + /* NV nv; Uncomment this if you need to return NVs */ + /* const char *pv; Uncomment this if you need to return PVs */ + INPUT: + SV * sv; + const char * s = SvPV(sv, len); + PPCODE: + /* Change this to constant(aTHX_ s, len, &iv, &nv); + if you need to return both NVs and IVs */ + type = constant(aTHX_ s, len, &iv); + /* Return 1 or 2 items. First is error message, or undef if no error. + Second, if present, is found value */ + switch (type) { + case PERL_constant_NOTFOUND: + sv = sv_2mortal(newSVpvf("%s is not a valid Time::HiRes macro", s)); + PUSHs(sv); + break; + case PERL_constant_NOTDEF: + sv = sv_2mortal(newSVpvf( + "Your vendor has not defined Time::HiRes macro %s, used", s)); + PUSHs(sv); + break; + case PERL_constant_ISIV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHi(iv); + break; + /* Uncomment this if you need to return NOs + case PERL_constant_ISNO: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_no); + break; */ + /* Uncomment this if you need to return NVs + case PERL_constant_ISNV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHn(nv); + break; */ + /* Uncomment this if you need to return PVs + case PERL_constant_ISPV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHp(pv, strlen(pv)); + break; */ + /* Uncomment this if you need to return PVNs + case PERL_constant_ISPVN: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHp(pv, iv); + break; */ + /* Uncomment this if you need to return SVs + case PERL_constant_ISSV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(sv); + break; */ + /* Uncomment this if you need to return UNDEFs + case PERL_constant_ISUNDEF: + break; */ + /* Uncomment this if you need to return UVs + case PERL_constant_ISUV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHu((UV)iv); + break; */ + /* Uncomment this if you need to return YESs + case PERL_constant_ISYES: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_yes); + break; */ + default: + sv = sv_2mortal(newSVpvf( + "Unexpected return type %d while processing Time::HiRes macro %s, used", + type, s)); + PUSHs(sv); + } |