Ancient
view release on metacpan or search on metacpan
bench/is_extended.pl view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings;
use Benchmark qw(cmpthese);
use lib 'blib/lib', 'blib/arch';
use Scalar::Util qw(blessed looks_like_number);
use util qw(is_num is_int is_blessed is_scalar_ref is_regex is_glob);
print "=" x 60, "\n";
print "Extended Type Predicates Benchmark\n";
print "=" x 60, "\n\n";
my $num = 42.5;
my $int = 42;
my $str = "hello";
my $obj = bless {}, 'MyClass';
my $sref = \my $x;
my $regex = qr/foo/;
print "=== is_num ===\n";
cmpthese(-2, {
'util::is_num' => sub { is_num($num) },
'looks_like_number' => sub { looks_like_number($num) },
});
print "\n=== is_num (string) ===\n";
cmpthese(-2, {
'util::is_num' => sub { is_num($str) },
'looks_like_number' => sub { looks_like_number($str) },
});
print "\n=== is_int ===\n";
cmpthese(-2, {
'util::is_int' => sub { is_int($int) },
'pure_perl' => sub { $int == int($int) },
});
print "\n=== is_blessed ===\n";
cmpthese(-2, {
lib/object.pm view on Meta::CPAN
=head3 Complete Example
/* MyTypes.xs */
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "object_types.h"
static bool check_positive_int(pTHX_ SV *val) {
if (!SvIOK(val) && !(SvPOK(val) && looks_like_number(val)))
return false;
return SvIV(val) > 0;
}
static bool check_email(pTHX_ SV *val) {
if (SvROK(val)) return false;
STRLEN len;
const char *pv = SvPV(val, len);
const char *at = memchr(pv, '@', len);
return at && at != pv && at != pv + len - 1;
lib/util.pm view on Meta::CPAN
if (is_hash($config)) { ... }
if (is_code($callback)) { ... }
if (is_defined($value)) { ... }
# Boolean/Truthiness predicates
if (is_true($value)) { ... } # Perl truth semantics
if (is_false($value)) { ... } # Perl false semantics
my $normalized = bool($value); # Normalize to 1 or ''
# Extended type predicates
if (is_num($value)) { ... } # Numeric value or looks like number
if (is_int($value)) { ... } # Integer value
if (is_blessed($obj)) { ... } # Blessed reference
if (is_scalar_ref($ref)) { ... } # Scalar reference
if (is_regex($qr)) { ... } # Compiled regex (qr//)
if (is_glob(*FH)) { ... } # Glob
# Numeric predicates
if (is_positive($num)) { ... } # > 0
if (is_negative($num)) { ... } # < 0
if (is_zero($num)) { ... } # == 0
lib/util.pm view on Meta::CPAN
=head1 EXTENDED TYPE PREDICATES
These functions use custom ops for extended type checking.
=head2 is_num
my $bool = is_num($value);
Returns true if C<$value> is numeric (has a numeric value or
looks like a number). Uses C<looks_like_number> for strings.
=head2 is_int
my $bool = is_int($value);
Returns true if C<$value> is an integer. Returns true for
whole number floats like 5.0.
=head2 is_blessed
t/1030-util-predicates-valid.t view on Meta::CPAN
# Numbers
ok(is_num(0), 'is_num: 0');
ok(is_num(42), 'is_num: positive int');
ok(is_num(-42), 'is_num: negative int');
ok(is_num(3.14), 'is_num: float');
ok(is_num(-3.14), 'is_num: negative float');
ok(is_num(1e10), 'is_num: scientific notation');
};
subtest 'is_num edge cases' => sub {
# String that looks like number
ok(is_num('42'), 'is_num: string 42');
ok(is_num('3.14'), 'is_num: string 3.14');
ok(is_num('-5'), 'is_num: string -5');
ok(is_num('1e10'), 'is_num: string scientific');
# Special values (Perl's looks_like_number considers these numeric)
ok(is_num(0.0), 'is_num: 0.0');
ok(is_num('NaN'), 'is_num: string NaN (Perl considers numeric)');
ok(is_num('inf'), 'is_num: string inf (Perl considers numeric)');
# Whitespace (Perl's looks_like_number accepts leading/trailing spaces)
ok(is_num(' 42 '), 'is_num: number with spaces (Perl accepts)');
ok(!is_num('42abc'), 'is_num: number with trailing text');
};
# ============================================
# is_int
# ============================================
subtest 'is_int basic' => sub {
# Not integers
t/1030-util-predicates-valid.t view on Meta::CPAN
# Normalize to true (1)
is(bool(1), 1, 'bool: 1 -> 1');
is(bool(-1), 1, 'bool: -1 -> 1');
is(bool('hello'), 1, 'bool: string -> 1');
is(bool([]), 1, 'bool: array -> 1');
is(bool({}), 1, 'bool: hash -> 1');
};
subtest 'is_true/is_false edge cases' => sub {
# String that looks numeric
ok(is_true('00'), 'is_true: string 00 is true');
ok(is_true('0.0'), 'is_true: string 0.0 is true');
ok(is_true('0e0'), 'is_true: string 0e0 is true');
# Numeric zero variations
ok(!is_true(0.0), 'is_true: 0.0 is false');
ok(!is_true(-0), 'is_true: -0 is false');
# Whitespace
ok(is_true(' '), 'is_true: space is true');
t/4006-object-types-custom.t view on Meta::CPAN
# ==== Test XS-level type registration API ====
# This tests the Perl-level API, but demonstrates the pattern
# that XS modules would use at the C level
# The C-level API works like this (in an external .xs file):
#
# #include "object_types.h"
#
# static bool check_positive_int(pTHX_ SV *val) {
# if (!SvIOK(val) && !looks_like_number(val)) return false;
# return SvIV(val) > 0;
# }
#
# BOOT:
# object_register_type_xs(aTHX_ "PositiveInt", check_positive_int, NULL);
#
# The registered C function is called directly from the setter op
# with no Perl callback overhead (~5 cycles vs ~100 cycles)
# For now, test with Perl callbacks (same flow, different overhead)
t/4007-object-edge-cases.t view on Meta::CPAN
$obj->num(-999);
is($obj->num, -999, 'Int accepts negative');
$obj->num(999999999);
is($obj->num, 999999999, 'Int accepts large positive');
# Float should be rejected or truncated
eval { $obj->num(3.14) };
like($@, qr/Type constraint failed/, 'Int rejects float');
# String that looks like int
$obj->num('42');
is($obj->num, '42', 'Int accepts numeric string');
eval { $obj->num('42.5') };
like($@, qr/Type constraint failed/, 'Int rejects decimal string');
};
# ==== Num Edge Cases ====
subtest 'Num edge cases' => sub {
xs/const/const.c view on Meta::CPAN
SV *val = cSVOPx_sv(argop);
SV *newval = newSVsv(val);
OP *markerop;
/* Make it deeply readonly if it's a reference */
if (SvROK(newval)) {
_make_readonly(aTHX_ SvRV(newval));
}
SvREADONLY_on(newval);
/* Create a custom op that looks like SVOP but uses our pp func */
markerop = newSVOP(OP_CUSTOM, 0, newval);
markerop->op_ppaddr = pp_confold_marker;
op_free(entersubop);
return markerop;
}
/* Non-constant arg - fall through to XS for runtime evaluation */
}
/* Fall through to XS implementation */
xs/const/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/const/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/const/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/const/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/doubly/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/doubly/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/doubly/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/doubly/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/file/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/file/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/file/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/file/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/heap/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/heap/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/heap/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/heap/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/lru/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/lru/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/lru/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/lru/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/noop/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/noop/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/noop/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/noop/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/nvec/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/nvec/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/nvec/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/nvec/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/object/object.c view on Meta::CPAN
return true;
case TYPE_DEFINED:
/* SvOK checks if defined, but be defensive for older Perls */
/* where constant 0 might have edge cases */
return SvOK(val) || SvIOK(val) || SvNOK(val) || SvPOK(val);
case TYPE_STR:
return SvOK(val) && !SvROK(val); /* defined non-ref */
case TYPE_INT:
if (SvIOK(val)) return true;
if (SvPOK(val)) {
/* String that looks like integer */
STRLEN len;
const char *pv;
const char *p;
pv = SvPV(val, len);
if (len == 0) return false;
p = pv;
if (*p == '-' || *p == '+') p++;
while (*p && *p >= '0' && *p <= '9') p++;
return p == pv + len;
}
return false;
case TYPE_NUM:
return SvNIOK(val) || (SvPOK(val) && looks_like_number(val));
case TYPE_BOOL:
/* Accept 0, 1, "", or boolean SVs */
if (SvIOK(val)) {
IV iv = SvIV(val);
return iv == 0 || iv == 1;
}
return SvTRUE(val) || !SvOK(val) || (SvPOK(val) && SvCUR(val) == 0);
case TYPE_ARRAYREF:
return SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVAV;
case TYPE_HASHREF:
xs/object/object_types.h view on Meta::CPAN
* object_types.h - Type registration API for external XS modules
*
* Include this header in your XS module to register optimized C-level
* type checks that bypass Perl callback overhead entirely.
*
* Usage in your .xs file:
*
* #include "object_types.h"
*
* static bool check_positive_int(pTHX_ SV *val) {
* if (!SvIOK(val) && !looks_like_number(val)) return false;
* return SvIV(val) > 0;
* }
*
* static bool check_email(pTHX_ SV *val) {
* if (SvROK(val)) return false;
* STRLEN len;
* const char *pv = SvPV(val, len);
* return memchr(pv, '@', len) != NULL;
* }
*
xs/object/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/object/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/object/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/object/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/slot/ppport.h view on Meta::CPAN
}
usage() if $opt{help};
strip() if $opt{strip};
$opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'};
$opt{'compat-version'} = int_parse_version($opt{'compat-version'});
my $int_min_perl = int_parse_version(5.003_07);
# Each element of this hash looks something like:
# 'Poison' => {
# 'base' => '5.008000',
# 'provided' => 1,
# 'todo' => '5.003007'
# },
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
xs/slot/ppport.h view on Meta::CPAN
LONGJMP_tb_pb|5.033003||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
LOOKBEHIND_END_t8_p8|||Viu
LOOKBEHIND_END_t8_pb|||Viu
LOOKBEHIND_END_t8|||Viu
LOOKBEHIND_END_tb_p8|||Viu
LOOKBEHIND_END_tb_pb|||Viu
LOOKBEHIND_END_tb|||Viu
LOOKBEHIND_END|||Viu
looks_like_bool|5.027008||Viu
looks_like_number|5.003007|5.003007|
LOOP_PAT_MODS|5.009005||Viu
lop|5.005000||Viu
lossless_NV_to_IV|5.031001||Vniu
LOWEST_ANYOF_HRx_BYTE|5.031002||Viu
L_R_TZSET|5.009005|5.009005|Vn
lsbit_pos32|5.035003||cVnu
lsbit_pos|5.035004||Viu
lsbit_pos64|5.035003||cVnu
lsbit_pos_uintmax|5.035003||Viu
lseek|5.005000||Viu
xs/slot/ppport.h view on Meta::CPAN
# define D_PPP_TO_FOLD_CALLEE(s,r,l) \
Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL)
# endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
: D_PPP_TO_ ## name ## _CALLEE(s,r,l))
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
#endif
xs/slot/ppport.h view on Meta::CPAN
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
xs/util/ppport.h view on Meta::CPAN
keyword|||
leave_scope|||
lex_end|||
lex_start|||
linklist|||
listkids|||
list|||
load_module_nocontext|||vn
load_module|5.006000||pv
localize|||
looks_like_bool|||
looks_like_number|||
lop|||
mPUSHi|5.009002||p
mPUSHn|5.009002||p
mPUSHp|5.009002||p
mPUSHs|5.011000||p
mPUSHu|5.009002||p
mXPUSHi|5.009002||p
mXPUSHn|5.009002||p
mXPUSHp|5.009002||p
mXPUSHs|5.011000||p
xs/util/util.c view on Meta::CPAN
return (SvROK(elem) && SvTYPE(SvRV(elem)) == SVt_PVHV) ? TRUE : FALSE;
}
static bool builtin_is_code(pTHX_ SV *elem) {
return (SvROK(elem) && SvTYPE(SvRV(elem)) == SVt_PVCV) ? TRUE : FALSE;
}
static bool builtin_is_positive(pTHX_ SV *elem) {
if (SvIOK(elem)) return SvIV(elem) > 0;
if (SvNOK(elem)) return SvNV(elem) > 0;
if (SvPOK(elem) && looks_like_number(elem)) return SvNV(elem) > 0;
return FALSE;
}
static bool builtin_is_negative(pTHX_ SV *elem) {
if (SvIOK(elem)) return SvIV(elem) < 0;
if (SvNOK(elem)) return SvNV(elem) < 0;
if (SvPOK(elem) && looks_like_number(elem)) return SvNV(elem) < 0;
return FALSE;
}
static bool builtin_is_zero(pTHX_ SV *elem) {
if (SvIOK(elem)) return SvIV(elem) == 0;
if (SvNOK(elem)) return SvNV(elem) == 0.0;
if (SvPOK(elem) && looks_like_number(elem)) return SvNV(elem) == 0.0;
return FALSE;
}
static bool builtin_is_even(pTHX_ SV *elem) {
if (!SvIOK(elem) && !SvNOK(elem)) {
if (!SvPOK(elem) || !looks_like_number(elem)) return FALSE;
}
IV val = SvIV(elem);
return (val % 2) == 0;
}
static bool builtin_is_odd(pTHX_ SV *elem) {
if (!SvIOK(elem) && !SvNOK(elem)) {
if (!SvPOK(elem) || !looks_like_number(elem)) return FALSE;
}
IV val = SvIV(elem);
return (val % 2) != 0;
}
static bool builtin_is_empty(pTHX_ SV *elem) {
if (!SvOK(elem)) return TRUE;
if (SvROK(elem)) {
SV *rv = SvRV(elem);
if (SvTYPE(rv) == SVt_PVAV) return AvFILL((AV*)rv) < 0;
xs/util/util.c view on Meta::CPAN
static bool builtin_is_nonempty(pTHX_ SV *elem) {
return !builtin_is_empty(aTHX_ elem);
}
static bool builtin_is_string(pTHX_ SV *elem) {
return (SvPOK(elem) && !SvIOK(elem) && !SvNOK(elem) && !SvROK(elem)) ? TRUE : FALSE;
}
static bool builtin_is_number(pTHX_ SV *elem) {
if (SvIOK(elem) || SvNOK(elem)) return TRUE;
if (SvPOK(elem) && looks_like_number(elem)) return TRUE;
return FALSE;
}
static bool builtin_is_integer(pTHX_ SV *elem) {
if (SvIOK(elem) && !SvNOK(elem)) return TRUE;
if (SvNOK(elem)) {
NV val = SvNV(elem);
return val == (NV)(IV)val;
}
if (SvPOK(elem) && looks_like_number(elem)) {
NV val = SvNV(elem);
return val == (NV)(IV)val;
}
return FALSE;
}
/* ============================================
Callback registry functions
============================================ */
xs/util/util.c view on Meta::CPAN
dSP;
SV *sv = TOPs;
SETs(SvTRUE(sv) ? &PL_sv_yes : &PL_sv_no);
RETURN;
}
/* ============================================
Extended type predicate custom ops - blazing fast!
============================================ */
/* is_num: check if value is numeric (has numeric value or looks like number) */
static OP* pp_is_num(pTHX) {
dSP;
SV *sv = TOPs;
/* SvNIOK: has numeric (NV or IV) value cached */
/* Also check looks_like_number for strings that can be numbers */
SETs((SvNIOK(sv) || looks_like_number(sv)) ? &PL_sv_yes : &PL_sv_no);
RETURN;
}
/* is_int: check if value is an integer */
static OP* pp_is_int(pTHX) {
dSP;
SV *sv = TOPs;
/* SvIOK: has integer value cached */
if (SvIOK(sv)) {
SETs(&PL_sv_yes);
} else if (SvNOK(sv)) {
/* It's a float - check if it's a whole number */
NV nv = SvNV(sv);
SETs((nv == (NV)(IV)nv) ? &PL_sv_yes : &PL_sv_no);
} else if (looks_like_number(sv)) {
/* String that looks like a number - check if integer */
STRLEN len;
const char *pv = SvPV(sv, len);
/* Simple check: no decimal point or exponent */
bool has_dot = FALSE;
STRLEN i;
for (i = 0; i < len; i++) {
if (pv[i] == '.' || pv[i] == 'e' || pv[i] == 'E') {
has_dot = TRUE;
break;
}
xs/util/util.c view on Meta::CPAN
/* ============================================
Numeric predicate custom ops - blazing fast!
Direct SvNV comparison, minimal overhead
============================================ */
/* is_positive: check if value is > 0 */
static OP* pp_is_positive(pTHX) {
dSP;
SV *sv = TOPs;
if (SvNIOK(sv) || looks_like_number(sv)) {
NV nv = SvNV(sv);
SETs((nv > 0) ? &PL_sv_yes : &PL_sv_no);
} else {
SETs(&PL_sv_no);
}
RETURN;
}
/* is_negative: check if value is < 0 */
static OP* pp_is_negative(pTHX) {
dSP;
SV *sv = TOPs;
if (SvNIOK(sv) || looks_like_number(sv)) {
NV nv = SvNV(sv);
SETs((nv < 0) ? &PL_sv_yes : &PL_sv_no);
} else {
SETs(&PL_sv_no);
}
RETURN;
}
/* is_zero: check if value is == 0 */
static OP* pp_is_zero(pTHX) {
dSP;
SV *sv = TOPs;
if (SvNIOK(sv) || looks_like_number(sv)) {
NV nv = SvNV(sv);
SETs((nv == 0) ? &PL_sv_yes : &PL_sv_no);
} else {
SETs(&PL_sv_no);
}
RETURN;
}
/* ============================================
Numeric utility custom ops
xs/util/util.c view on Meta::CPAN
SV *sv = TOPs;
if (SvIOK(sv)) {
SETs((SvIVX(sv) & 1) == 0 ? &PL_sv_yes : &PL_sv_no);
} else if (SvNIOK(sv)) {
NV nv = SvNV(sv);
if (nv == (NV)(IV)nv) {
SETs(((IV)nv & 1) == 0 ? &PL_sv_yes : &PL_sv_no);
} else {
SETs(&PL_sv_no);
}
} else if (looks_like_number(sv)) {
SETs((SvIV(sv) & 1) == 0 ? &PL_sv_yes : &PL_sv_no);
} else {
SETs(&PL_sv_no);
}
RETURN;
}
/* is_odd: check if integer is odd (single bitwise AND) */
static OP* pp_is_odd(pTHX) {
dSP;
SV *sv = TOPs;
if (SvIOK(sv)) {
SETs((SvIVX(sv) & 1) == 1 ? &PL_sv_yes : &PL_sv_no);
} else if (SvNIOK(sv)) {
NV nv = SvNV(sv);
if (nv == (NV)(IV)nv) {
SETs(((IV)nv & 1) == 1 ? &PL_sv_yes : &PL_sv_no);
} else {
SETs(&PL_sv_no);
}
} else if (looks_like_number(sv)) {
SETs((SvIV(sv) & 1) == 1 ? &PL_sv_yes : &PL_sv_no);
} else {
SETs(&PL_sv_no);
}
RETURN;
}
/* is_between: check if value is between min and max (inclusive) */
static OP* pp_is_between(pTHX) {
dSP;
SV *max_sv = POPs;
SV *min_sv = POPs;
SV *val_sv = TOPs;
if (SvNIOK(val_sv) || looks_like_number(val_sv)) {
NV val = SvNV(val_sv);
NV min = SvNV(min_sv);
NV max = SvNV(max_sv);
SETs((val >= min && val <= max) ? &PL_sv_yes : &PL_sv_no);
} else {
SETs(&PL_sv_no);
}
RETURN;
}
xs/util/util.c view on Meta::CPAN
/* ============================================
Numeric custom ops
============================================ */
/* sign: return -1, 0, or 1 based on value */
static OP* pp_sign(pTHX) {
dSP;
SV *sv = TOPs;
if (!SvNIOK(sv) && !looks_like_number(sv)) {
SETs(&PL_sv_undef);
RETURN;
}
NV nv = SvNV(sv);
if (nv > 0) {
SETs(sv_2mortal(newSViv(1)));
} else if (nv < 0) {
SETs(sv_2mortal(newSViv(-1)));
} else {
xs/util/util.c view on Meta::CPAN
}
/* ============================================
Extended type predicate XS fallbacks
============================================ */
static XS(xs_is_num) {
dXSARGS;
if (items != 1) croak("Usage: util::is_num($value)");
SV *sv = ST(0);
ST(0) = (SvNIOK(sv) || looks_like_number(sv)) ? &PL_sv_yes : &PL_sv_no;
XSRETURN(1);
}
static XS(xs_is_int) {
dXSARGS;
if (items != 1) croak("Usage: util::is_int($value)");
SV *sv = ST(0);
if (SvIOK(sv)) {
ST(0) = &PL_sv_yes;
} else if (SvNOK(sv)) {
NV nv = SvNV(sv);
ST(0) = (nv == (NV)(IV)nv) ? &PL_sv_yes : &PL_sv_no;
} else if (looks_like_number(sv)) {
STRLEN len;
const char *pv = SvPV(sv, len);
bool has_dot = FALSE;
STRLEN i;
for (i = 0; i < len; i++) {
if (pv[i] == '.' || pv[i] == 'e' || pv[i] == 'E') {
has_dot = TRUE;
break;
}
}
xs/util/util.c view on Meta::CPAN
}
/* ============================================
Numeric predicate XS fallbacks
============================================ */
static XS(xs_is_positive) {
dXSARGS;
if (items != 1) croak("Usage: util::is_positive($value)");
SV *sv = ST(0);
if (SvNIOK(sv) || looks_like_number(sv)) {
NV nv = SvNV(sv);
ST(0) = (nv > 0) ? &PL_sv_yes : &PL_sv_no;
} else {
ST(0) = &PL_sv_no;
}
XSRETURN(1);
}
static XS(xs_is_negative) {
dXSARGS;
if (items != 1) croak("Usage: util::is_negative($value)");
SV *sv = ST(0);
if (SvNIOK(sv) || looks_like_number(sv)) {
NV nv = SvNV(sv);
ST(0) = (nv < 0) ? &PL_sv_yes : &PL_sv_no;
} else {
ST(0) = &PL_sv_no;
}
XSRETURN(1);
}
static XS(xs_is_zero) {
dXSARGS;
if (items != 1) croak("Usage: util::is_zero($value)");
SV *sv = ST(0);
if (SvNIOK(sv) || looks_like_number(sv)) {
NV nv = SvNV(sv);
ST(0) = (nv == 0) ? &PL_sv_yes : &PL_sv_no;
} else {
ST(0) = &PL_sv_no;
}
XSRETURN(1);
}
/* ============================================
Numeric utility XS fallbacks
xs/util/util.c view on Meta::CPAN
SV *sv = ST(0);
if (SvIOK(sv)) {
ST(0) = (SvIVX(sv) & 1) == 0 ? &PL_sv_yes : &PL_sv_no;
} else if (SvNIOK(sv)) {
NV nv = SvNV(sv);
if (nv == (NV)(IV)nv) {
ST(0) = ((IV)nv & 1) == 0 ? &PL_sv_yes : &PL_sv_no;
} else {
ST(0) = &PL_sv_no;
}
} else if (looks_like_number(sv)) {
ST(0) = (SvIV(sv) & 1) == 0 ? &PL_sv_yes : &PL_sv_no;
} else {
ST(0) = &PL_sv_no;
}
XSRETURN(1);
}
static XS(xs_is_odd) {
dXSARGS;
if (items != 1) croak("Usage: util::is_odd($value)");
SV *sv = ST(0);
if (SvIOK(sv)) {
ST(0) = (SvIVX(sv) & 1) == 1 ? &PL_sv_yes : &PL_sv_no;
} else if (SvNIOK(sv)) {
NV nv = SvNV(sv);
if (nv == (NV)(IV)nv) {
ST(0) = ((IV)nv & 1) == 1 ? &PL_sv_yes : &PL_sv_no;
} else {
ST(0) = &PL_sv_no;
}
} else if (looks_like_number(sv)) {
ST(0) = (SvIV(sv) & 1) == 1 ? &PL_sv_yes : &PL_sv_no;
} else {
ST(0) = &PL_sv_no;
}
XSRETURN(1);
}
static XS(xs_is_between) {
dXSARGS;
if (items != 3) croak("Usage: util::is_between($value, $min, $max)");
SV *val_sv = ST(0);
SV *min_sv = ST(1);
SV *max_sv = ST(2);
if (SvNIOK(val_sv) || looks_like_number(val_sv)) {
NV val = SvNV(val_sv);
NV min = SvNV(min_sv);
NV max = SvNV(max_sv);
ST(0) = (val >= min && val <= max) ? &PL_sv_yes : &PL_sv_no;
} else {
ST(0) = &PL_sv_no;
}
XSRETURN(1);
}
xs/util/util.c view on Meta::CPAN
/* ============================================
Numeric XS fallbacks
============================================ */
static XS(xs_sign) {
dXSARGS;
if (items != 1) croak("Usage: util::sign($number)");
SV *sv = ST(0);
if (!SvNIOK(sv) && !looks_like_number(sv)) {
ST(0) = &PL_sv_undef;
XSRETURN(1);
}
NV nv = SvNV(sv);
if (nv > 0) {
ST(0) = sv_2mortal(newSViv(1));
} else if (nv < 0) {
ST(0) = sv_2mortal(newSViv(-1));
} else {
xs/util/util_callbacks.h view on Meta::CPAN
/*
* The following built-in predicates are available:
*
* Type checks:
* :is_defined - SvOK(elem)
* :is_ref - SvROK(elem)
* :is_array - arrayref
* :is_hash - hashref
* :is_code - coderef
* :is_string - plain scalar (not ref, not number)
* :is_number - numeric (IV, NV, or looks_like_number)
* :is_integer - integer value (no fractional part)
*
* Boolean checks:
* :is_true - SvTRUE(elem)
* :is_false - !SvTRUE(elem)
*
* Numeric checks:
* :is_positive - value > 0
* :is_negative - value < 0
* :is_zero - value == 0
( run in 3.937 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )