AVLTree
view release on metacpan or search on metacpan
#ifdef __cplusplus
extern "C" {
#endif
/*
From http://blogs.perl.org/users/nick_wellnhofer/2015/03/writing-xs-like-a-pro---perl-no-get-context-and-static-functions.html
The perlxs man page recommends to define the PERL_NO_GET_CONTEXT macro before including EXTERN.h, perl.h, and XSUB.h.
If this macro is defined, it is assumed that the interpreter context is passed as a parameter to every function.
If it's undefined, the context will typically be fetched from thread-local storage when calling the Perl API, which
incurs a performance overhead.
WARNING:
setting this macro involves additional changes to the XS code. For example, if the XS file has static functions that
call into the Perl API, you'll get somewhat cryptic error messages like the following:
/usr/lib/i386-linux-gnu/perl/5.20/CORE/perl.h:155:16: error: ‘my_perl’ undeclared (first use in this function)
# define aTHX my_perl
avltree/avltree.c view on Meta::CPAN
while ( it != NULL ) {
int cmp = tree->cmp ( it->data, data );
if ( cmp == 0 )
break;
it = it->link[cmp < 0];
}
return it == NULL ? &PL_sv_undef : it->data;
}
int avltree_insert ( avltree_t *tree, SV *data )
{
/* Empty tree case */
if ( tree->root == NULL ) {
tree->root = new_node ( tree, data );
if ( tree->root == NULL )
return 0;
}
avltree/avltree.c view on Meta::CPAN
trav->top = 0;
/* Build a path to work with */
if ( trav->it != NULL ) {
while ( trav->it->link[dir] != NULL ) {
trav->path[trav->top++] = trav->it;
trav->it = trav->it->link[dir];
}
}
return trav->it == NULL ? &PL_sv_undef : trav->it->data;
}
/*
Subsequent traversal steps,
handles ascending and descending
*/
static SV *move (pTHX_ avltrav_t *trav, int dir )
{
if ( trav->it->link[dir] != NULL ) {
/* Continue down this branch */
avltree/avltree.c view on Meta::CPAN
if ( trav->top == 0 ) {
trav->it = NULL;
break;
}
last = trav->it;
trav->it = trav->path[--trav->top];
} while ( last == trav->it->link[dir] );
}
return trav->it == NULL ? &PL_sv_undef : trav->it->data;
}
SV *avltfirst (pTHX_ avltrav_t *trav, avltree_t *tree )
{
return start (aTHX_ trav, tree, 0 ); /* Min value */
}
SV *avltlast (pTHX_ avltrav_t *trav, avltree_t *tree )
{
return start (aTHX_ trav, tree, 1 ); /* Max value */
lib/AVLTree.pm view on Meta::CPAN
Arg [1] : (required) A reference to a subroutine
Example : my $tree->new(\&compare);
carp "Unable to instantiate tree" unless defined $tree;
Description : Creates a new AVL tree object.
The objects hold by the tree are implicitly defined
by the provided callback.
Returntype : AVLTreePtr or undef if unable to instantiate
Exceptions : None
Caller : General
Status : Unstable, interface might change to accomodate suitable defaults,
e.g. numbers
=head2 C<find>
Arg [1] : Item to search, can be defined just in terms of the attribute
with which the items in the tree are compared.
Example : $tree->find({ id => 10 }); # objects in the tree can hold data as well
if($result) {
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else { print "Item with id $id not found\n"; }
Description : Query if an item exists in the tree.
Returntype : The item, if found, as stored in the tree or undef
if the item was not found or the query was not provided
or it was undefined.
Exceptions : None
Caller : General
Status : Unstable
=head2 C<insert>
Arg [1] : An item to insert in the tree.
Example : my $ok = $tree->insert({ id => 10, data => 'ten' });
croak "Unable to insert 10" unless $ok;
lib/AVLTree.pm view on Meta::CPAN
=head1 TREE TRAVERSAL METHODS
=head2 C<first>
Arg [...] : None
Example : my $item = $tree->first;
Description : Returns the first element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
Exceptions : None
Caller : General
Status : Unstable
=head2 C<last>
Arg [...] : None
Example : my $item = $tree->last;
Description : Returns the last element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
Exceptions : None
Caller : General
Status : Unstable
=head2 C<next>
Arg [...] : None
Example : my $item = $tree->first;
print $item, "\n";
while($item = $tree->next) { print $item, "\n"; }
Description : Returns the next element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
Exceptions : None
Caller : General
Status : Unstable
=head2 C<prev>
Arg [...] : None
Example : my $item = $tree->last;
print $item, "\n";
while($item = $tree->prev) { print $item, "\n"; }
Description : Returns the previous element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
Exceptions : None
Caller : General
Status : Unstable
=head1 DEPENDENCIES
AVLTree requires Carp and Test::More, Test::Deep and Test::LeakTrace to run the tests during installation.
If you want to run the benchmarks in the scripts directory, you need to install the Benchmark
and List::Util modules.
PL_rsfp_filters|5.014000||p
PL_rsfp|5.014000||p
PL_rs|||n
PL_signals|5.008001||p
PL_stack_base|5.004050||p
PL_stack_sp|5.004050||p
PL_statcache|5.005000||p
PL_stdingv|5.004050||p
PL_sv_arenaroot|5.004050||p
PL_sv_no|5.004050||pn
PL_sv_undef|5.004050||pn
PL_sv_yes|5.004050||pn
PL_tainted|5.004050||p
PL_tainting|5.004050||p
PL_tokenbuf|5.014000||p
POP_MULTICALL||5.014000|
POPi|||n
POPl|||n
POPn|||n
POPpbytex||5.007001|n
POPpx||5.005030|n
av_fetch|||
av_fill|||
av_iter_p||5.011000|
av_len|||
av_make|||
av_pop|||
av_push|||
av_reify|||
av_shift|||
av_store|||
av_undef|||
av_unshift|||
ax|||n
bad_type|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
blockhook_register||5.013003|
boolSV|5.004000||p
boot_core_PerlIO|||
custom_op_desc||5.007003|
custom_op_name||5.007003|
custom_op_register||5.013007|
custom_op_xop||5.013007|
cv_ckproto_len|||
cv_clone|||
cv_const_sv||5.004000|
cv_dump|||
cv_get_call_checker||5.013006|
cv_set_call_checker||5.013006|
cv_undef|||
cvgv_set|||
cvstash_set|||
cx_dump||5.005000|
cx_dup|||
cxinc|||
dAXMARK|5.009003||p
dAX|5.007002||p
dITEMS|5.007002||p
dMARK|||
dMULTICALL||5.009003|
filter_del|||
filter_gets|||
filter_read|||
find_and_forget_pmops|||
find_array_subscript|||
find_beginning|||
find_byclass|||
find_hash_subscript|||
find_in_my_stash|||
find_runcv||5.008001|
find_rundefsvoffset||5.009002|
find_rundefsv||5.013002|
find_script|||
find_uninit_var|||
first_symbol|||n
foldEQ_latin1||5.013008|n
foldEQ_locale||5.013002|n
foldEQ_utf8_flags||5.013010|
foldEQ_utf8||5.013002|
foldEQ||5.013002|n
fold_constants|||
forbid_setid|||
hv_placeholders_get||5.009003|
hv_placeholders_p||5.009003|
hv_placeholders_set||5.009003|
hv_riter_p||5.009003|
hv_riter_set||5.009003|
hv_scalar||5.009001|
hv_store_ent||5.004000|
hv_store_flags||5.008000|
hv_stores|5.009004||p
hv_store|||
hv_undef_flags|||
hv_undef|||
ibcmp_locale||5.004000|
ibcmp_utf8||5.007003|
ibcmp|||
incline|||
incpush_if_exists|||
incpush_use_sep|||
incpush|||
ingroup|||
init_argv_symbols|||
init_dbargs|||
while (<DATA>) {
if ($hint) {
my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
if (m{^\s*\*\s(.*?)\s*$}) {
for (@{$hint->[1]}) {
$h->{$_} ||= ''; # suppress warning with older perls
$h->{$_} .= "$1\n";
}
}
else { undef $hint }
}
$hint = [$1, [split /,?\s+/, $2]]
if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
if ($define) {
if ($define->[1] =~ /\\$/) {
$define->[1] .= $_;
}
else {
if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
my @n = find_api($define->[1]);
push @{$depends{$define->[0]}}, @n if @n
}
undef $define;
}
}
$define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
if ($function) {
if (/^}/) {
if (exists $API{$function->[0]}) {
my @n = find_api($function->[1]);
push @{$depends{$function->[0]}}, @n if @n
}
undef $function;
}
else {
$function->[1] .= $_;
}
}
$function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
$replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
$replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
unlink $tmp;
return $diff;
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
return () if $seen->{$func}++;
my %s;
grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
#endif
#ifndef PTR2UV
# define PTR2UV(p) INT2PTR(UV,p)
#endif
#ifndef PTR2NV
# define PTR2NV(p) NUM2PTR(NV,p)
#endif
#undef START_EXTERN_C
#undef END_EXTERN_C
#undef EXTERN_C
#ifdef __cplusplus
# define START_EXTERN_C extern "C" {
# define END_EXTERN_C }
# define EXTERN_C extern "C"
#else
# define START_EXTERN_C
# define END_EXTERN_C
# define EXTERN_C extern
#endif
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
# endif
#endif
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
# ifndef PERL_USE_GCC_BRACE_GROUPS
# define PERL_USE_GCC_BRACE_GROUPS
# endif
#endif
#undef STMT_START
#undef STMT_END
#ifdef PERL_USE_GCC_BRACE_GROUPS
# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
# define STMT_END )
#else
# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
# define STMT_START if (1)
# define STMT_END else (void)0
# else
# define STMT_START do
# define STMT_END while (0)
#endif
#ifndef dAXMARK
# define dAXMARK I32 ax = POPMARK; \
register SV ** const mark = PL_stack_base + ax++
#endif
#ifndef XSprePUSH
# define XSprePUSH (sp = PL_stack_base + ax - 1)
#endif
#if (PERL_BCDVERSION < 0x5005000)
# undef XSRETURN
# define XSRETURN(off) \
STMT_START { \
PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
return; \
} STMT_END
#endif
#ifndef XSPROTO
# define XSPROTO(name) void name(pTHX_ CV* cv)
#endif
# define isXDIGIT(c) isxdigit(c)
#endif
#else
# if (PERL_BCDVERSION < 0x5010000)
/* Hint: isPRINT
* The implementation in older perl versions includes all of the
* isSPACE() characters, which is wrong. The version provided by
* Devel::PPPort always overrides a present buggy version.
*/
# undef isPRINT
# endif
#ifndef isALNUMC
# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
#endif
#ifndef isASCII
# define isASCII(c) ((U8) (c) <= 127)
#endif
#ifndef isCNTRL
# define PL_perl_destruct_level perl_destruct_level
# define PL_perldb perldb
# define PL_rsfp_filters rsfp_filters
# define PL_rsfp rsfp
# define PL_stack_base stack_base
# define PL_stack_sp stack_sp
# define PL_statcache statcache
# define PL_stdingv stdingv
# define PL_sv_arenaroot sv_arenaroot
# define PL_sv_no sv_no
# define PL_sv_undef sv_undef
# define PL_sv_yes sv_yes
# define PL_tainted tainted
# define PL_tainting tainting
# define PL_tokenbuf tokenbuf
/* Replace: 0 */
#endif
/* Warning: PL_parser
* For perl versions earlier than 5.9.5, this is an always
* non-NULL dummy. Also, it cannot be dereferenced. Don't
# define PERL_LOADMOD_NOIMPORT 0x2
#endif
#ifndef PERL_LOADMOD_IMPORT_OPS
# define PERL_LOADMOD_IMPORT_OPS 0x4
#endif
#ifndef G_METHOD
# define G_METHOD 64
# ifdef call_sv
# undef call_sv
# endif
# if (PERL_BCDVERSION < 0x5006000)
# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
(flags) & ~G_METHOD) : perl_call_sv(sv, flags))
# else
# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
(flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
# endif
#endif
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
SV*
DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
dSP;
#ifndef vload_module
#if defined(NEED_vload_module)
static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
static
#else
extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
#endif
#ifdef vload_module
# undef vload_module
#endif
#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
#define Perl_vload_module DPPP_(my_vload_module)
#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
void
DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
{
dTHR;
#ifndef load_module
#if defined(NEED_load_module)
static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
static
#else
extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
#endif
#ifdef load_module
# undef load_module
#endif
#define load_module DPPP_(my_load_module)
#define Perl_load_module DPPP_(my_load_module)
#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
void
DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
{
va_list args;
#ifndef newRV_noinc
#if defined(NEED_newRV_noinc)
static SV * DPPP_(my_newRV_noinc)(SV *sv);
static
#else
extern SV * DPPP_(my_newRV_noinc)(SV *sv);
#endif
#ifdef newRV_noinc
# undef newRV_noinc
#endif
#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
SV *
DPPP_(my_newRV_noinc)(SV *sv)
{
SV *rv = (SV *)newRV(sv);
SvREFCNT_dec(sv);
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
static
#else
extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
#endif
#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
#define D_PPP_PL_copline PL_copline
#ifndef newSV_type
#if defined(NEED_newSV_type)
static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
static
#else
extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
#endif
#ifdef newSV_type
# undef newSV_type
#endif
#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
#define Perl_newSV_type DPPP_(my_newSV_type)
#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
SV*
DPPP_(my_newSV_type)(pTHX_ svtype const t)
{
SV* const sv = newSV(0);
#ifndef newSVpvn_flags
#if defined(NEED_newSVpvn_flags)
static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
static
#else
extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
#endif
#ifdef newSVpvn_flags
# undef newSVpvn_flags
#endif
#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
SV *
DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
{
SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
#if (PERL_BCDVERSION < 0x5007000)
#if defined(NEED_sv_2pvbyte)
static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
static
#else
extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
#endif
#ifdef sv_2pvbyte
# undef sv_2pvbyte
#endif
#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
char *
DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
{
sv_utf8_downgrade(sv,0);
return SvPV(sv,*lp);
}
#endif
/* Hint: sv_2pvbyte
* Use the SvPVbyte() macro instead of sv_2pvbyte().
*/
#undef SvPVbyte
#define SvPVbyte(sv, lp) \
((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
#endif
#else
# define SvPVbyte SvPV
#endif
/* Hint: sv_pvn
* Always use the SvPV() macro instead of sv_pvn().
*/
/* Hint: sv_pvn_force
* Always use the SvPV_force() macro instead of sv_pvn_force().
*/
/* If these are undefined, they're not handled by the core anyway */
#ifndef SV_IMMEDIATE_UNREF
# define SV_IMMEDIATE_UNREF 0
#endif
#ifndef SV_GMAGIC
# define SV_GMAGIC 0
#endif
#ifndef SV_COW_DROP_PV
# define SV_COW_DROP_PV 0
#if (PERL_BCDVERSION < 0x5007002)
#if defined(NEED_sv_2pv_flags)
static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
static
#else
extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
#endif
#ifdef sv_2pv_flags
# undef sv_2pv_flags
#endif
#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
char *
DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
{
STRLEN n_a = (STRLEN) flags;
#endif
#if defined(NEED_sv_pvn_force_flags)
static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
static
#else
extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
#endif
#ifdef sv_pvn_force_flags
# undef sv_pvn_force_flags
#endif
#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
char *
DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
{
STRLEN n_a = (STRLEN) flags;
#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
#if defined(NEED_vnewSVpvf)
static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
static
#else
extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
#endif
#ifdef vnewSVpvf
# undef vnewSVpvf
#endif
#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
SV *
DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
{
register SV *sv = newSV(0);
#ifndef newSVpvn_share
#if defined(NEED_newSVpvn_share)
static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
static
#else
extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
#endif
#ifdef newSVpvn_share
# undef newSVpvn_share
#endif
#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
SV *
DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
{
SV *sv;
#ifndef grok_numeric_radix
#if defined(NEED_grok_numeric_radix)
static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
static
#else
extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
#endif
#ifdef grok_numeric_radix
# undef grok_numeric_radix
#endif
#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
bool
DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
#ifdef PL_numeric_radix_sv
#ifndef grok_number
#if defined(NEED_grok_number)
static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
static
#else
extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
#endif
#ifdef grok_number
# undef grok_number
#endif
#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
#define Perl_grok_number DPPP_(my_grok_number)
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
int
DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
const char *send = pv + len;
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#ifndef pv_escape
#if defined(NEED_pv_escape)
static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
static
#else
extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
#endif
#ifdef pv_escape
# undef pv_escape
#endif
#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
#define Perl_pv_escape DPPP_(my_pv_escape)
#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
char *
DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
const STRLEN count, const STRLEN max,
STRLEN * const escaped, const U32 flags)
#ifndef pv_pretty
#if defined(NEED_pv_pretty)
static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
static
#else
extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
#endif
#ifdef pv_pretty
# undef pv_pretty
#endif
#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
#define Perl_pv_pretty DPPP_(my_pv_pretty)
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
char *
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
#ifndef pv_display
#if defined(NEED_pv_display)
static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
static
#else
extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
#endif
#ifdef pv_display
# undef pv_display
#endif
#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
#define Perl_pv_display DPPP_(my_pv_display)
#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
char *
DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
{
pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
t/01-numbers.t view on Meta::CPAN
}
my $tree = AVLTree->new(\&cmp_f);
isa_ok($tree, "AVLTree");
is($tree->size(), 0, "Empty tree upon construction");
map { ok($tree->insert($_), "Insert item") } qw/10 20 30 40 50 25/;
is($tree->size(), 6, "Tree size after insertion");
ok(!$tree->find(), "No query");
ok(!$tree->find(undef), "Undefined query");
my $query = 30;
my $result = $tree->find($query);
ok($result, "Item found");
ok(!$tree->find(18), "Item not found");
ok(!$tree->remove(1), "Non existent item not removed");
is($tree->size(), 6, "Tree size preserved after unsuccessful removal");
ok($tree->remove(20), "Existing item removed");
t/02-custom.t view on Meta::CPAN
{ id => 20, data => ['twenty'] },
{ id => 30, data => ['thirty'] },
{ id => 40, data => ['forty'] },
{ id => 50, data => ['fifty'] },
{ id => 25, data => ['twentyfive'] },
];
map { ok($tree->insert($_), "Insert item") } @{$items};
is($tree->size(), 6, "Tree size after insertion");
ok(!$tree->find(), "No query");
ok(!$tree->find(undef), "Undefined query");
my $query = { id => 30, data => 'something' };
my $result = $tree->find($query);
ok($result, "Item found");
cmp_deeply($result, { id => 30, data => ['thirty'] }, "Item returned");
ok(!$tree->find({ id => 18 }), "Item not found");
ok(!$tree->remove({ id => 1 }), "Non existent item not removed");
is($tree->size(), 6, "Tree size preserved after unsuccessful removal");
( run in 4.659 seconds using v1.01-cache-2.11-cpan-d80b1682f3f )