AVLTree

 view release on metacpan or  search on metacpan

AVLTree.xs  view on Meta::CPAN

  int count;

  //ENTER;
  //SAVETMPS;
  
  PUSHMARK(SP);
  XPUSHs(sv_2mortal(newSVsv(p1)));
  XPUSHs(sv_2mortal(newSVsv(p2)));
  PUTBACK;
  
  /* Call the Perl sub to process the callback */
  count = call_sv(callback, G_SCALAR);

  SPAGAIN;

  if(count != 1)
    croak("Did not return a value\n");
  
  cmp = POPi;
  PUTBACK;

CONTRIBUTING  view on Meta::CPAN

You can obtain the most recent development version of this module via the GitHub
repository at https://github.com/avullo/AVLTree. Please feel free to fork, submit
bug reports, patches, pull requests etc.

Makefile.PL  view on Meta::CPAN

     },
},	      
    LIBS      => [''],   # e.g., '-lm',
    DEFINE    => '-DENABLE_DEBUG', # e.g., '-DHAVE_SOMETHING'	      
    INC       => '-Iavltree',     # e.g., '-I/usr/include/other'
    MYEXTLIB  => 'avltree/libavltree$(LIB_EXT)',	      
    dist  => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
    clean => { FILES => 'AVLTree-*' },
);

sub MY::postamble {
'
$(MYEXTLIB): avltree/Makefile
	cd avltree && $(MAKE) $(PASSTHRU)
';
}

README  view on Meta::CPAN

    Search CPAN
        http://search.cpan.org/dist/AVLTree/

AUTHOR

Alessandro Vullo <avullo@cpan.org>

CONTRIBUTING

You can obtain the most recent development version of this module via the GitHub
repository at https://github.com/avullo/AVLTree. Please feel free to submit bug
reports, patches etc.

LICENSE AND COPYRIGHT

Copyright (C) [2017-2018] Alessandro Vullo

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

avltree/Makefile.PL  view on Meta::CPAN

use ExtUtils::MakeMaker;

$Verbose = 1;
WriteMakefile(
	      NAME   => 'AVLTree::avltree',
	      SKIP   => [qw(all static static_lib dynamic dynamic_lib)],
	      clean  => {'FILES' => 'libavltree$(LIB_EXT)'},
	     );

sub MY::top_targets {
'
all :: static
pure_all :: static
static ::       libavltree$(LIB_EXT)
libavltree$(LIB_EXT): $(O_FILES)
	$(AR) cr libavltree$(LIB_EXT) $(O_FILES)
	$(RANLIB) libavltree$(LIB_EXT)
';
}

lib/AVLTree.pm  view on Meta::CPAN

for creating and querying an AVL tree, get its size and insert and remove elements 
from it. Additionaly, it is possible to traverse the tree in forward/reverse order.

=head1 SYNOPSIS

  use AVLTree;

  # Define a function to compare two numbers i1 and i2,
  # return -1 if i1 < i2, 1 if i2 > i1 and 0 otherwise 

  sub cmp_f = sub {
    my ($i1, $i2) = @_;

    return $i1<$i2?-1:($i1>$i2)?1:0;
  }

  # Instantiate a tree which holds numbers
  my $tree = AVLTree->new(\&cmp_f);
  
  # Add some numbers to the tree
  map { $tree->insert($_) } qw/10 20 30 40 50 25/;

lib/AVLTree.pm  view on Meta::CPAN

  
  printf "Size of tree is now: %d\n", $tree->size();

  ...

  # Suppose you want the tree to hold generic data items, e.g. hashrefs
  # which hold some data. We can deal with these by definying a custom
  # comparison function based on one of the attributes of these data items, 
  # e.g. 'id':
 
  sub compare {
    my ($i1, $i2) = @_;
    my ($id1, $id2) = ($i1->{id}, $i2->{id});

    croak "Cannot compare items based on id"
      unless defined $id1 and defined $id2;
  
    return $id1<$id2?-1:($id1>$id2)?1:0;
  }

  # Now can do the same as with numbers

lib/AVLTree.pm  view on Meta::CPAN

  }

  # and similarly for reverse iteratio, using last/prev methods

  ...

=head1 METHODS

=head2 C<new>

  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

lib/AVLTree.pm  view on Meta::CPAN


=head1 BUGS

Please report any bugs or feature requests to C<bug-avltree at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AVLTree>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 CONTRIBUTING

You can obtain the most recent development version of this module via the GitHub
repository at https://github.com/avullo/AVLTree. Please feel free to submit bug
reports, patches etc.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc AVLTree

You can also look for information at:

ppport.h  view on Meta::CPAN

PERL_MAGIC_overload|5.007002||p
PERL_MAGIC_pos|5.007002||p
PERL_MAGIC_qr|5.007002||p
PERL_MAGIC_regdata|5.007002||p
PERL_MAGIC_regdatum|5.007002||p
PERL_MAGIC_regex_global|5.007002||p
PERL_MAGIC_shared_scalar|5.007003||p
PERL_MAGIC_shared|5.007003||p
PERL_MAGIC_sigelem|5.007002||p
PERL_MAGIC_sig|5.007002||p
PERL_MAGIC_substr|5.007002||p
PERL_MAGIC_sv|5.007002||p
PERL_MAGIC_taint|5.007002||p
PERL_MAGIC_tiedelem|5.007002||p
PERL_MAGIC_tiedscalar|5.007002||p
PERL_MAGIC_tied|5.007002||p
PERL_MAGIC_utf8|5.008001||p
PERL_MAGIC_uvar_elem|5.007003||p
PERL_MAGIC_uvar|5.007002||p
PERL_MAGIC_vec|5.007002||p
PERL_MAGIC_vstring|5.008001||p

ppport.h  view on Meta::CPAN

PERL_UNUSED_DECL|5.007002||p
PERL_UNUSED_VAR|5.007002||p
PERL_UQUAD_MAX|5.004000||p
PERL_UQUAD_MIN|5.004000||p
PERL_USE_GCC_BRACE_GROUPS|5.009004||p
PERL_USHORT_MAX|5.004000||p
PERL_USHORT_MIN|5.004000||p
PERL_VERSION|5.006000||p
PL_DBsignal|5.005000||p
PL_DBsingle|||pn
PL_DBsub|||pn
PL_DBtrace|||pn
PL_Sv|5.005000||p
PL_bufend|5.014000||p
PL_bufptr|5.014000||p
PL_compiling|5.004050||p
PL_copline|5.014000||p
PL_curcop|5.004050||p
PL_curstash|5.004050||p
PL_debstash|5.004050||p
PL_defgv|5.004050||p

ppport.h  view on Meta::CPAN

cast_i32||5.006000|
cast_iv||5.006000|
cast_ulong||5.006000|
cast_uv||5.006000|
check_type_and_open|||
check_uni|||
check_utf8_print|||
checkcomma|||
checkposixcc|||
ckWARN|5.006000||p
ck_entersub_args_list||5.013006|
ck_entersub_args_proto_or_list||5.013006|
ck_entersub_args_proto||5.013006|
ck_warner_d||5.011001|v
ck_warner||5.011001|v
ckwarn_common|||
ckwarn_d||5.009003|
ckwarn||5.009003|
cl_and|||n
cl_anything|||n
cl_init|||n
cl_is_anything|||n
cl_or|||n

ppport.h  view on Meta::CPAN

dofindlabel|||
doform|||
doing_taint||5.008001|n
dooneliner|||
doopen_pm|||
doparseform|||
dopoptoeval|||
dopoptogiven|||
dopoptolabel|||
dopoptoloop|||
dopoptosub_at|||
dopoptowhen|||
doref||5.009003|
dounwind|||
dowantarray|||
dump_all_perl|||
dump_all||5.006000|
dump_eval||5.006000|
dump_exec_pos|||
dump_fds|||
dump_form||5.006000|
dump_indent||5.006000|v
dump_mstats|||
dump_packsubs_perl|||
dump_packsubs||5.006000|
dump_sub_perl|||
dump_sub||5.006000|
dump_sv_child|||
dump_trie_interim_list|||
dump_trie_interim_table|||
dump_trie|||
dump_vindent||5.006000|
dumpuntil|||
dup_attrlist|||
emulate_cop_io|||
eval_pv|5.006000||p
eval_sv|5.006000||p

ppport.h  view on Meta::CPAN

expect_number|||
fbm_compile||5.005000|
fbm_instr||5.005000|
feature_is_enabled|||
fetch_cop_label||5.011000|
filter_add|||
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|

ppport.h  view on Meta::CPAN

free_global_struct|||
free_tied_hv_pool|||
free_tmps|||
gen_constant_list|||
get_aux_mg|||
get_av|5.006000||p
get_context||5.006000|n
get_cvn_flags|5.009005||p
get_cvs|5.011000||p
get_cv|5.006000||p
get_db_sub|||
get_debug_opts|||
get_hash_seed|||
get_hv|5.006000||p
get_mstats|||
get_no_modify|||
get_num|||
get_op_descs||5.005000|
get_op_names||5.005000|
get_opargs|||
get_ppaddr||5.006000|

ppport.h  view on Meta::CPAN

isSPACE|||
isUPPER|||
isWORDCHAR||5.013006|
isXDIGIT|5.006000||p
is_an_int|||
is_ascii_string||5.011000|n
is_gv_magical_sv|||
is_handle_constructor|||n
is_inplace_av|||
is_list_assignment|||
is_lvalue_sub||5.007001|
is_uni_alnum_lc||5.006000|
is_uni_alnum||5.006000|
is_uni_alpha_lc||5.006000|
is_uni_alpha||5.006000|
is_uni_ascii_lc||5.006000|
is_uni_ascii||5.006000|
is_uni_cntrl_lc||5.006000|
is_uni_cntrl||5.006000|
is_uni_digit_lc||5.006000|
is_uni_digit||5.006000|

ppport.h  view on Meta::CPAN

magic_dump||5.006000|
magic_existspack|||
magic_freearylen_p|||
magic_freeovrld|||
magic_getarylen|||
magic_getdefelem|||
magic_getnkeys|||
magic_getpack|||
magic_getpos|||
magic_getsig|||
magic_getsubstr|||
magic_gettaint|||
magic_getuvar|||
magic_getvec|||
magic_get|||
magic_killbackrefs|||
magic_len|||
magic_methcall1|||
magic_methcall|||v
magic_methpack|||
magic_nextpack|||

ppport.h  view on Meta::CPAN

magic_setdefelem|||
magic_setenv|||
magic_sethint|||
magic_setisa|||
magic_setmglob|||
magic_setnkeys|||
magic_setpack|||
magic_setpos|||
magic_setregexp|||
magic_setsig|||
magic_setsubstr|||
magic_settaint|||
magic_setutf8|||
magic_setuvar|||
magic_setvec|||
magic_set|||
magic_sizepack|||
magic_wipepack|||
make_matcher|||
make_trie_failtable|||
make_trie|||

ppport.h  view on Meta::CPAN

scan_const|||
scan_formline|||
scan_heredoc|||
scan_hex|||
scan_ident|||
scan_inputsymbol|||
scan_num||5.007001|
scan_oct|||
scan_pat|||
scan_str|||
scan_subst|||
scan_trans|||
scan_version||5.009001|
scan_vstring||5.009005|
scan_word|||
screaminstr||5.005000|
search_const|||
seed||5.008001|
sequence_num|||
sequence_tail|||
sequence|||

ppport.h  view on Meta::CPAN

share_hek||5.004000|
si_dup|||
sighandler|||n
simplify_sort|||
skipspace0|||
skipspace1|||
skipspace2|||
skipspace|||
softref2xv|||
sortcv_stacked|||
sortcv_xsub|||
sortcv|||
sortsv_flags||5.009003|
sortsv||5.007003|
space_join_names_mortal|||
ss_dup|||
stack_grow|||
start_force|||
start_glob|||
start_subparse||5.004000|
stashpv_hvname_match||5.014000|
stdize_locale|||
store_cop_label|||
strEQ|||
strGE|||
strGT|||
strLE|||
strLT|||
strNE|||
str_to_version||5.006000|
strip_return|||
strnEQ|||
strnNE|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool_flags||5.013006|
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_common|||
sv_2iuv_non_preserve|||
sv_2iv_flags||5.009001|
sv_2iv|||
sv_2mortal|||
sv_2num|||

ppport.h  view on Meta::CPAN

sys_intern_clear|||
sys_intern_dup|||
sys_intern_init|||
sys_term||5.010000|n
taint_env|||
taint_proper|||
tied_method|||v
tmps_grow||5.006000|
toLOWER|||
toUPPER|||
to_byte_substr|||
to_uni_fold||5.007003|
to_uni_lower_lc||5.006000|
to_uni_lower||5.007003|
to_uni_title_lc||5.006000|
to_uni_title||5.007003|
to_uni_upper_lc||5.006000|
to_uni_upper||5.007003|
to_utf8_case||5.007003|
to_utf8_fold||5.007003|
to_utf8_lower||5.007003|
to_utf8_substr|||
to_utf8_title||5.007003|
to_utf8_upper||5.007003|
token_free|||
token_getmad|||
tokenize_use|||
tokeq|||
tokereport|||
too_few_arguments|||
too_many_arguments|||
try_amagic_bin|||

ppport.h  view on Meta::CPAN

whichsig|||
with_queued_errors|||
write_no_mem|||
write_to_stderr|||
xmldump_all_perl|||
xmldump_all|||
xmldump_attr|||
xmldump_eval|||
xmldump_form|||
xmldump_indent|||v
xmldump_packsubs_perl|||
xmldump_packsubs|||
xmldump_sub_perl|||
xmldump_sub|||
xmldump_vindent|||
xs_apiversion_bootcheck|||
xs_version_bootcheck|||
yyerror|||
yylex|||
yyparse|||
yyunlex|||
yywarn|||
);

ppport.h  view on Meta::CPAN

  }
  exit 0;
}

# Scan for possible replacement candidates

my(%replace, %need, %hints, %warnings, %depends);
my $replace = 0;
my($hint, $define, $function);

sub find_api
{
  my $code = shift;
  $code =~ s{
    / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
  | "[^"\\]*(?:\\.[^"\\]*)*"
  | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
  grep { exists $API{$_} } $code =~ /(\w+)/mg;
}

while (<DATA>) {

ppport.h  view on Meta::CPAN

    else {
      my @new = grep { -f } glob $_
          or warn "'$_' does not exist.\n";
      push @files, grep { !$seen{$_}++ } @new;
    }
  }
}
else {
  eval {
    require File::Find;
    File::Find::find(sub {
      $File::Find::name =~ /($srcext)$/i
          and push @files, $File::Find::name;
    }, '.');
  };
  if ($@) {
    @files = map { glob "*$_" } @srcext;
  }
}

if (!@ARGV || $opt{filter}) {

ppport.h  view on Meta::CPAN

  else {
    info("Looks good");
  }
}

close PATCH if $patch_opened;

exit 0;


sub try_use { eval "use @_;"; return $@ eq '' }

sub mydiff
{
  local *F = shift;
  my($file, $str) = @_;
  my $diff;

  if (exists $opt{diff}) {
    $diff = run_diff($opt{diff}, $file, $str);
  }

  if (!defined $diff and try_use('Text::Diff')) {

ppport.h  view on Meta::CPAN

  }

  if (!defined $diff) {
    error("Cannot generate a diff. Please install Text::Diff or use --copy.");
    return;
  }

  print F $diff;
}

sub run_diff
{
  my($prog, $file, $str) = @_;
  my $tmp = 'dppptemp';
  my $suf = 'aaa';
  my $diff = '';
  local *F;

  while (-e "$tmp.$suf") { $suf++ }
  $tmp = "$tmp.$suf";

ppport.h  view on Meta::CPAN


    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}};
}

sub parse_version
{
  my $ver = shift;

  if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
    return ($1, $2, $3);
  }
  elsif ($ver !~ /^\d+\.[\d_]+$/) {
    die "cannot parse version '$ver'\n";
  }

ppport.h  view on Meta::CPAN


  if ($r < 5 || ($r == 5 && $v < 6)) {
    if ($s % 10) {
      die "cannot parse version '$ver'\n";
    }
  }

  return ($r, $v, $s);
}

sub format_version
{
  my $ver = shift;

  $ver =~ s/$/000000/;
  my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;

  $v = int $v;
  $s = int $s;

  if ($r < 5 || ($r == 5 && $v < 6)) {

ppport.h  view on Meta::CPAN


    $ver = sprintf "%d.%03d", $r, $v;
    $s > 0 and $ver .= sprintf "_%02d", $s;

    return $ver;
  }

  return sprintf "%d.%d.%d", $r, $v, $s;
}

sub info
{
  $opt{quiet} and return;
  print @_, "\n";
}

sub diag
{
  $opt{quiet} and return;
  $opt{diag} and print @_, "\n";
}

sub warning
{
  $opt{quiet} and return;
  print "*** ", @_, "\n";
}

sub error
{
  print "*** ERROR: ", @_, "\n";
}

my %given_hints;
my %given_warnings;
sub hint
{
  $opt{quiet} and return;
  my $func = shift;
  my $rv = 0;
  if (exists $warnings{$func} && !$given_warnings{$func}++) {
    my $warn = $warnings{$func};
    $warn =~ s!^!*** !mg;
    print "*** WARNING: $func\n", $warn;
    $rv++;
  }
  if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
    my $hint = $hints{$func};
    $hint =~ s/^/   /mg;
    print "   --- hint for $func ---\n", $hint;
  }
  $rv;
}

sub usage
{
  my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
  my %M = ( 'I' => '*' );
  $usage =~ s/^\s*perl\s+\S+/$^X $0/;
  $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;

  print <<ENDUSAGE;

Usage: $usage

See perldoc $0 for details.

ENDUSAGE

  exit 2;
}

sub strip
{
  my $self = do { local(@ARGV,$/)=($0); <> };
  my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
  $copy =~ s/^(?=\S+)/    /gms;
  $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
  $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
  eval { require Devel::PPPort };
  \$@ and die "Cannot require Devel::PPPort, please install.\\n";
  if (eval \$Devel::PPPort::VERSION < $VERSION) {

ppport.h  view on Meta::CPAN

/* Replace: 1 */
#  define PL_ppaddr                 ppaddr
#  define PL_no_modify              no_modify
/* Replace: 0 */
#endif

#if (PERL_BCDVERSION <= 0x5004005)
/* Replace: 1 */
#  define PL_DBsignal               DBsignal
#  define PL_DBsingle               DBsingle
#  define PL_DBsub                  DBsub
#  define PL_DBtrace                DBtrace
#  define PL_Sv                     Sv
#  define PL_bufend                 bufend
#  define PL_bufptr                 bufptr
#  define PL_compiling              compiling
#  define PL_copline                copline
#  define PL_curcop                 curcop
#  define PL_curstash               curstash
#  define PL_debstash               debstash
#  define PL_defgv                  defgv

ppport.h  view on Meta::CPAN

	    imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
	    sv = va_arg(*args, SV*);
	}
    }
    {
	const line_t ocopline = PL_copline;
	COP * const ocurcop = PL_curcop;
	const int oexpect = PL_expect;

#if (PERL_BCDVERSION >= 0x5004000)
	utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
		veop, modname, imop);
#else
	utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
		modname, imop);
#endif
	PL_expect = oexpect;
	PL_copline = ocopline;
	PL_curcop = ocurcop;
    }
}

#endif
#endif

ppport.h  view on Meta::CPAN

	line_t oldline = PL_curcop->cop_line;
	PL_curcop->cop_line = D_PPP_PL_copline;

	PL_hints &= ~HINT_BLOCK_SCOPE;
	if (stash)
		PL_curstash = PL_curcop->cop_stash = stash;

	newSUB(

#if   (PERL_BCDVERSION < 0x5003022)
		start_subparse(),
#elif (PERL_BCDVERSION == 0x5003022)
     		start_subparse(0),
#else  /* 5.003_23  onwards */
     		start_subparse(FALSE, 0),
#endif

		newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
		newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
		newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
	);

	PL_hints = oldhints;
	PL_curcop->cop_stash = old_cop_stash;
	PL_curstash = old_curstash;

ppport.h  view on Meta::CPAN

#endif

#ifndef PERL_MAGIC_vec
#  define PERL_MAGIC_vec                 'v'
#endif

#ifndef PERL_MAGIC_utf8
#  define PERL_MAGIC_utf8                'w'
#endif

#ifndef PERL_MAGIC_substr
#  define PERL_MAGIC_substr              'x'
#endif

#ifndef PERL_MAGIC_defelem
#  define PERL_MAGIC_defelem             'y'
#endif

#ifndef PERL_MAGIC_glob
#  define PERL_MAGIC_glob                '*'
#endif

ppport.h  view on Meta::CPAN

    const char *s = start;
    STRLEN len = *len_p;
    UV value = 0;
    NV value_nv = 0;

    const UV max_div_8 = UV_MAX / 8;
    bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
    bool overflowed = FALSE;

    for (; len-- && *s; s++) {
         /* gcc 2.95 optimiser not smart enough to figure that this subtraction
            out front allows slicker code.  */
        int digit = *s - '0';
        if (digit >= 0 && digit <= 7) {
            /* Write it in this wonky order with a goto to attempt to get the
               compiler to make the common case integer-only loop pretty tight.
            */
          redo:
            if (!overflowed) {
                if (value <= max_div_8) {
                    value = (value << 3) | digit;

scripts/benchmarks.pl  view on Meta::CPAN

# $diff = timediff($end, $start);
# printf "time taken was %s seconds\n", timestr($diff, 'all');

$start = new Benchmark;
print "[AVLTree]\t\t";
map { $avltree->remove($_) } @items;
$end = new Benchmark;
$diff = timediff($end, $start);
printf "time taken was %s seconds\n", timestr($diff, 'all');

sub cmp_f {
  my ($i1, $i2) = @_;

  return $i1<$i2?-1:($i1>$i2)?1:0;
}

t/01-numbers.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;

plan tests => 28;

use AVLTree;

# test AVL tree with numbers

sub cmp_f {
  my ($i1, $i2) = @_;

  return $i1<$i2?-1:($i1>$i2)?1:0;
}

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/;

t/02-custom.t  view on Meta::CPAN

use Carp;

plan tests => 31;

use AVLTree;

# test AVL tree with custom data

# suppose data comes as a hash ref where the comparison is based on
# on the values associated to a given key, e.g. id
sub cmp_f {
  my ($i1, $i2) = @_;
  my ($id1, $id2) = ($i1->{id}, $i2->{id});
  croak "Cannot compare items based on id"
    unless defined $id1 and defined $id2;
  
  return $id1<$id2?-1:($id1>$id2)?1:0;
}

my $tree = AVLTree->new(\&cmp_f);
isa_ok($tree, "AVLTree");

t/03-leak.t  view on Meta::CPAN

use strict;
use warnings FATAL => 'all';

use constant HAS_LEAKTRACE => eval{ require Test::LeakTrace };
use Test::More HAS_LEAKTRACE ? (tests => 10) : (skip_all => 'require Test::LeakTrace');
use Test::LeakTrace;
use Carp;

BEGIN { use_ok('AVLTree'); }

sub cmp_numbers {
  my ($i1, $i2) = @_;

  return $i1<$i2?-1:($i1>$i2)?1:0;
}

sub cmp_custom {
  my ($i1, $i2) = @_;
  my ($id1, $id2) = ($i1->{id}, $i2->{id});
  croak "Cannot compare items based on id"
    unless defined $id1 and defined $id2;
  
  return $id1<$id2?-1:($id1>$id2)?1:0;
}

# tests with numbers
no_leaks_ok {

xt/boilerplate.t  view on Meta::CPAN

#!perl -T
use 5.006;
use strict;
use warnings;
use Test::More;

plan tests => 3;

sub not_in_file_ok {
    my ($filename, %regex) = @_;
    open( my $fh, '<', $filename )
        or die "couldn't open $filename for reading: $!";

    my %violated;

    while (my $line = <$fh>) {
        while (my ($desc, $regex) = each %regex) {
            if ($line =~ $regex) {
                push @{$violated{$desc}||=[]}, $.;

xt/boilerplate.t  view on Meta::CPAN

    }

    if (%violated) {
        fail("$filename contains boilerplate text");
        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
    } else {
        pass("$filename contains no boilerplate text");
    }
}

sub module_boilerplate_ok {
    my ($module) = @_;
    not_in_file_ok($module =>
        'the great new $MODULENAME'   => qr/ - The great new /,
        'boilerplate description'     => qr/Quick summary of what the module/,
        'stub function definition'    => qr/function[12]/,
    );
}

TODO: {
  local $TODO = "Need to replace the boilerplate text";



( run in 0.576 second using v1.01-cache-2.11-cpan-88abd93f124 )