Algorithm-Diff-XS
view release on metacpan or search on metacpan
else
ctx->links.arr[k] = lk;
}
}
}
}
if (ctx->thresh.max >= 0) {
struct LK *lk;
if (GIMME_V == G_ARRAY) {
SV **start, **end;
XSprePUSH;
start = SP+1;
for (lk = ctx->links.arr[ctx->thresh.max]; lk; lk = lk->link) {
AV *arr;
/* only count transitions */
if (lk->link && lk->link->i == lk->i)
continue;
arr = newAV();
av_push(arr, newSViv(lk->i));
av_push(arr, newSViv(lk->j));
XPUSHs(sv_2mortal(newRV_noinc((SV *)arr)));
}
/* reverse the stack */
end = SP;
while (start < end) {
SV *tmp = *start;
*start++ = *end;
*end-- = tmp;
}
}
else {
j = 0;
for (lk = ctx->links.arr[ctx->thresh.max]; lk; lk = lk->link) {
if (lk->link && lk->link->i == lk->i)
continue;
++j;
}
av_reify|||
av_shift|||
av_store|||
av_undef|||
av_unshift|||
ax|||n
bad_type|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_xsutils|||
bytes_from_utf8||5.007001|
bytes_to_utf8||5.006001|
cache_re|||
call_argv|5.006000||p
call_atexit||5.006000|
call_body|||
is_utf8_string||5.006001|
is_utf8_upper||5.006000|
is_utf8_xdigit||5.006000|
isa_lookup|||
items|||n
ix|||n
jmaybe|||
keyword|||
leave_scope|||
lex_end|||
lex_start|||
linklist|||
listkids|||
list|||
load_module_nocontext|||vn
load_module||5.006000|v
localize|||
looks_like_number|||
lop|||
mPUSHi|5.009002||p
mPUSHn|5.009002||p
pMY_CXT|5.007003||p
pTHX_|5.006000||p
pTHX|5.006000||p
pack_cat||5.007003|
pack_rec|||
package|||
packlist||5.008001|
pad_add_anon|||
pad_add_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type|||
pad_findlex|||
pad_findmy|||
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
pad_new|||
pad_push|||
pad_reset|||
ptr_table_new|||
ptr_table_split|||
ptr_table_store|||
push_scope|||
put_byte|||
pv_display||5.006000|
pv_uni_display||5.007003|
qerror|||
re_croak2|||
re_dup|||
re_intuit_start||5.006000|
re_intuit_string||5.006000|
realloc||5.007002|n
reentrant_free|||
reentrant_init|||
reentrant_retry|||vn
reentrant_size|||
refkids|||
refto|||
ref|||
reg_node|||
setenv_getix|||
share_hek_flags|||
share_hek|||
si_dup|||
sighandler|||n
simplify_sort|||
skipspace|||
sortsv||5.007003|
ss_dup|||
stack_grow|||
start_glob|||
start_subparse||5.004000|
stashpv_hvname_match||5.009003|
stdize_locale|||
strEQ|||
strGE|||
strGT|||
strLE|||
strLT|||
strNE|||
str_to_version||5.006000|
strnEQ|||
strnNE|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_non_preserve|||
sv_2iv_flags||5.009001|
sv_2iv|||
sv_2mortal|||
sv_2nv|||
sv_2pv_flags||5.007002|
sv_2pv_nolen|5.006000||p
if (exists $opt{'api-info'}) {
my $f;
my $count = 0;
my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $f =~ /$match/;
print "\n=== $f ===\n\n";
my $info = 0;
if ($API{$f}{base} || $API{$f}{todo}) {
my $base = format_version($API{$f}{base} || $API{$f}{todo});
print "Supported at least starting from perl-$base.\n";
$info++;
}
if ($API{$f}{provided}) {
my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
print "Support by $ppport provided back to perl-$todo.\n";
print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
print "$hints{$f}" if exists $hints{$f};
$info++;
}
return rv;
}
#endif
#endif
/* Hint: newCONSTSUB
* Returns a CV* as of perl-5.7.1. This return value is not supported
* by Devel::PPPort.
*/
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
static
#else
extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
line_t oldline = PL_curcop->cop_line;
PL_curcop->cop_line = PL_copline;
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
start_subparse(),
#elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
start_subparse(0),
#else /* 5.003_23 onwards */
start_subparse(FALSE, 0),
#endif
newSVOP(OP_CONST, 0, newSVpv(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;
#endif
#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
void
DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
#ifdef PERL_IMPLICIT_CONTEXT
#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
#ifndef sv_catpvf_mg
#endif
#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
void
DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
#ifdef PERL_IMPLICIT_CONTEXT
#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
#ifndef sv_setpvf_mg
#endif
/*
* The grok_* routines have been modified to use warn() instead of
* Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
* which is why the stack variable has been renamed to 'xdigit'.
*/
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ 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_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
/* strip off leading b or 0b.
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ 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_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
const char *xdigit;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ 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_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
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
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Octal number > 037777777777 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
( run in 0.228 second using v1.01-cache-2.11-cpan-0d8aa00de5b )