Algorithm-AM
view release on metacpan or search on metacpan
1;
use strict;
BEGIN { require warnings if "$]" > '5.006' }
# Disable broken TRIE-optimization
BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= "5.009004" && "$]" <= "5.009005"}
my $VERSION = 3.62;
my %opt = (
quiet => 0,
diag => 1,
hints => 1,
changes => 1,
cplusplus => 0,
filter => 1,
strip => 0,
version => 0,
);
my($ppport) = $0 =~ /([\w.]+)$/;
my $LF = '(?:\r\n|[\r\n])'; # line feed
my $HS = "[ \t]"; # horizontal whitespace
# Never use C comments in this file!
my $ccs = '/'.'*';
my $cce = '*'.'/';
my $rccs = quotemeta $ccs;
my $rcce = quotemeta $cce;
eval {
require Getopt::Long;
Getopt::Long::GetOptions(\%opt, qw(
help quiet diag! filter! hints! changes! cplusplus strip version
patch=s copy=s diff=s compat-version=s
list-provided list-unsupported api-info=s
)) or usage();
};
if ($@ and grep /^-/, @ARGV) {
usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
die "Getopt::Long not found. Please don't use any options.\n";
}
if ($opt{version}) {
print "This is $0 $VERSION.\n";
exit 0;
}
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 ) : ()),
(index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
(index($4, 'n') >= 0 ? ( noTHXarg => 1 ) : ()),
(index($4, 'c') >= 0 ? ( core_only => 1 ) : ()),
(index($4, 'd') >= 0 ? ( deprecated => 1 ) : ()),
(index($4, 'i') >= 0 ? ( inaccessible => 1 ) : ()),
(index($4, 'x') >= 0 ? ( experimental => 1 ) : ()),
(index($4, 'u') >= 0 ? ( undocumented => 1 ) : ()),
(index($4, 'o') >= 0 ? ( ppport_fnc => 1 ) : ()),
(index($4, 'V') >= 0 ? ( unverified => 1 ) : ()),
} )
: die "invalid spec: $_" } qw(
ABDAY_1|5.027010||Viu
ABDAY_2|5.027010||Viu
ABDAY_3|5.027010||Viu
ABDAY_4|5.027010||Viu
ABDAY_5|5.027010||Viu
ABDAY_6|5.027010||Viu
ABDAY_7|5.027010||Viu
ABMON_10|5.027010||Viu
ABMON_11|5.027010||Viu
ABMON_12|5.027010||Viu
ABMON_1|5.027010||Viu
ABMON_2|5.027010||Viu
ABMON_3|5.027010||Viu
ABMON_4|5.027010||Viu
ABMON_5|5.027010||Viu
ABMON_6|5.027010||Viu
ABMON_7|5.027010||Viu
ABMON_8|5.027010||Viu
ABMON_9|5.027010||Viu
ABORT|5.003007||Viu
abort|5.005000||Viu
abort_execution|5.025010||Viu
accept|5.005000||Viu
ACCEPT|5.009005||Viu
access|5.005000||Viu
add_above_Latin1_folds|5.021001||Viu
add_cp_to_invlist|5.013011||Viu
add_data|5.005000||Vniu
add_multi_match|5.021004||Viu
_add_range_to_invlist|5.016000||cViu
add_utf16_textfilter|5.011001||Viu
adjust_size_and_find_bucket|5.019003||Vniu
advance_one_LB|5.023007||Viu
advance_one_SB|5.021009||Viu
advance_one_WB|5.021009||Viu
AHOCORASICK|5.009005||Viu
AHOCORASICKC|5.009005||Viu
alloccopstash|5.017001|5.017001|x
alloc_LOGOP|5.025004||xViu
LINKLIST|5.013006|5.013006|
list|5.003007||Viu
listen|5.005000||Viu
listkids|5.003007||Viu
LNBREAK|5.009005||Viu
load_charnames|5.031009||cViu
load_module|5.006000|5.003007|pv
load_module_nocontext|5.006000|5.006000|vn
LOCALE_INIT|5.024000||Viu
LOCALE_LOCK|5.024000||Viu
LOCALE_LOCK_V|5.027010||Viu
LOCALE_PAT_MOD|5.013006||Viu
LOCALE_PAT_MODS|5.013006||Viu
LOCALE_TERM|5.024000||Viu
LOCALE_UNLOCK|5.024000||Viu
LOCALE_UNLOCK_V|5.027010||Viu
localize|5.003007||Viu
LOCAL_PATCH_COUNT|5.003007||Viu
localtime|5.031010||Viu
LOCALTIME_MAX|5.010001|5.010001|Vn
LOCALTIME_MIN|5.010001|5.010001|Vn
LOCALTIME_R_NEEDS_TZSET|5.010000|5.010000|Vn
LOCALTIME_R_PROTO|5.008000|5.008000|Vn
LOCK_DOLLARZERO_MUTEX|5.008001||Viu
lockf|5.006000||Viu
LOCK_LC_NUMERIC_STANDARD|5.021010||pViu
LOCK_NUMERIC_STANDARD|5.021001||pViu
LOC_SED|5.003007|5.003007|Vn
LOGICAL|5.005000||Viu
LONGDBLINFBYTES|5.023000|5.023000|Vn
LONGDBLMANTBITS|5.023000|5.023000|Vn
LONGDBLNANBYTES|5.023000|5.023000|Vn
LONGDOUBLE_BIG_ENDIAN|5.021009||Viu
LONGDOUBLE_DOUBLEDOUBLE|5.021009||Viu
LONG_DOUBLE_EQUALS_DOUBLE|5.007001||Viu
LONG_DOUBLE_IS_DOUBLE|5.021003|5.021003|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE|5.023006|5.023006|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE|5.023006|5.023006|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE|5.023006|5.023006|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE|5.023006|5.023006|Vn
LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_UNKNOWN_FORMAT|5.021003|5.021003|Vn
LONG_DOUBLE_IS_VAX_H_FLOAT|5.025004|5.025004|Vn
LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN|5.021003|5.021003|Vn
LONG_DOUBLEKIND|5.021003|5.021003|Vn
LONGDOUBLE_LITTLE_ENDIAN|5.021009||Viu
LONGDOUBLE_MIX_ENDIAN|5.023006||Viu
LONG_DOUBLESIZE|5.005000|5.005000|Vn
LONG_DOUBLE_STYLE_IEEE|5.025007|5.025007|Vn
LONG_DOUBLE_STYLE_IEEE_EXTENDED|5.025007|5.025007|Vn
LONGDOUBLE_VAX_ENDIAN|5.025004||Viu
LONGDOUBLE_X86_80_BIT|5.021009||Viu
LONGJMP|5.005000||Viu
longjmp|5.005000||Viu
LONGLONGSIZE|5.005000|5.005000|Vn
LONGSIZE|5.004000|5.003007|oVn
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
lseek|5.005000||Viu
LSEEKSIZE|5.006000|5.006000|Vn
lstat|5.005000||Viu
LvFLAGS|5.015006||Viu
LVf_NEG_LEN|5.027001||Viu
LVf_NEG_OFF|5.027001||Viu
LVf_OUT_OF_RANGE|5.027001||Viu
LVRET|5.007001||Vi
LvSTARGOFF|5.019004||Viu
LvTARG|5.003007||Viu
LvTARGLEN|5.003007||Viu
LvTARGOFF|5.003007||Viu
LvTYPE|5.003007||Viu
magic_clear_all_env|5.004001||Viu
magic_cleararylen_p|5.017002||Viu
magic_clearenv|5.003007||Viu
magic_clearhint|5.009004||Vi
magic_clearhints|5.011000||Vi
magic_clearisa|5.010001||Viu
magic_clearpack|5.003007||Viu
magic_clearsig|5.003007||Viu
magic_copycallchecker|5.017000||Viu
magic_dump|5.006000|5.006000|u
magic_existspack|5.003007||Viu
magic_freearylen_p|5.009003||Viu
magic_freeovrld|5.007001||Viu
magic_get|5.003007||Viu
magic_getarylen|5.003007||Viu
magic_getdebugvar|5.021005||Viu
magic_getdefelem|5.004000||Viu
magic_getnkeys|5.004005||Viu
magic_getpack|5.003007||Viu
magic_getpos|5.003007||Viu
magic_getsig|5.003007||Viu
magic_getsubstr|5.004005||Viu
magic_gettaint|5.003007||Viu
magic_getuvar|5.003007||Viu
magic_getvec|5.004005||Viu
magic_killbackrefs|5.006000||Viu
magic_methcall1|5.013001||Viu
magic_methcall|||vi
magic_methpack|5.005000||Viu
magic_nextpack|5.003007||Viu
magic_regdata_cnt|5.006000||Viu
magic_regdatum_get|5.006000||Viu
magic_regdatum_set|5.006001||Viu
magic_scalarpack|5.009001||Viu
magic_set|5.003007||Viu
magic_set_all_env|5.004004||Viu
magic_setarylen|5.003007||Viu
magic_setcollxfrm|5.004000||Viu
magic_setdbline|5.003007||Viu
magic_setdebugvar|5.021005||Viu
magic_setdefelem|5.004000||Viu
magic_setenv|5.003007||Viu
#ifndef toLOWER_uvchr
# define toLOWER_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_lower(NATIVE_TO_UNI(c), s, l))
#endif
#ifndef toUPPER_uvchr
# define toUPPER_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_upper(NATIVE_TO_UNI(c), s, l))
#endif
#ifndef toTITLE_uvchr
# define toTITLE_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_title(NATIVE_TO_UNI(c), s, l))
#endif
#ifndef toFOLD_uvchr
# define toFOLD_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_fold( NATIVE_TO_UNI(c), s, l))
#endif
# if (PERL_BCDVERSION != 0x5015006) /* Just this version is broken */
/* Prefer the macro to the function */
# if defined toLOWER_utf8
# define D_PPP_TO_LOWER_CALLEE(s,r,l) toLOWER_utf8(s,r,l)
# else
# define D_PPP_TO_LOWER_CALLEE(s,r,l) to_utf8_lower(s,r,l)
# endif
# if defined toTITLE_utf8
# define D_PPP_TO_TITLE_CALLEE(s,r,l) toTITLE_utf8(s,r,l)
# else
# define D_PPP_TO_TITLE_CALLEE(s,r,l) to_utf8_title(s,r,l)
# endif
# if defined toUPPER_utf8
# define D_PPP_TO_UPPER_CALLEE(s,r,l) toUPPER_utf8(s,r,l)
# else
# define D_PPP_TO_UPPER_CALLEE(s,r,l) to_utf8_upper(s,r,l)
# endif
# if defined toFOLD_utf8
# define D_PPP_TO_FOLD_CALLEE(s,r,l) toFOLD_utf8(s,r,l)
# else
# define D_PPP_TO_FOLD_CALLEE(s,r,l) to_utf8_fold(s,r,l)
# endif
# else /* Below is 5.15.6, which failed to make the macros available
# outside of core, so we have to use the 'Perl_' form. khw
# decided it was easier to just handle this case than have to
# document the exception, and make an exception in the tests below
# */
# define D_PPP_TO_LOWER_CALLEE(s,r,l) \
Perl__to_utf8_lower_flags(aTHX_ s, r, l, 0, NULL)
# define D_PPP_TO_TITLE_CALLEE(s,r,l) \
Perl__to_utf8_title_flags(aTHX_ s, r, l, 0, NULL)
# define D_PPP_TO_UPPER_CALLEE(s,r,l) \
Perl__to_utf8_upper_flags(aTHX_ s, r, l, 0, NULL)
# 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
#ifndef toLOWER_utf8_safe
# define toLOWER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(LOWER,s,e,r,l)
#endif
#ifndef toTITLE_utf8_safe
# define toTITLE_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(TITLE,s,e,r,l)
#endif
#ifndef toFOLD_utf8_safe
# define toFOLD_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_MULTI_ARG_TO(FOLD,s,e,r,l)
#endif
#elif (PERL_BCDVERSION >= 0x5006000)
/* Here we have UTF-8 support, but using the original API where the case
* changing functions merely returned the changed code point; hence they
* couldn't handle multi-character results. */
# ifdef uvchr_to_utf8
# define D_PPP_UV_TO_UTF8 uvchr_to_utf8
# else
# define D_PPP_UV_TO_UTF8 uv_to_utf8
# endif
/* Get the utf8 of the case changed value, and store its length; then have
* to re-calculate the changed case value in order to return it */
# define D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(name, c, s, l) \
(*(l) = (D_PPP_UV_TO_UTF8(s, \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c)))) - (s)), \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c))))
#ifndef toLOWER_uvchr
# define toLOWER_uvchr(c, s, l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(lower, c, s, l)
#endif
#ifndef toUPPER_uvchr
# define toUPPER_uvchr(c, s, l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(upper, c, s, l)
#endif
#ifndef toTITLE_uvchr
# define toTITLE_uvchr(c, s, l) \
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,
* toUPPER_uvchr, toLOWER_uvchr, toTITLE_uvchr
The UTF-8 case changing operations had bugs before around 5.12 or 5.14;
this backport does not correct them.
In perls before 7.3, multi-character case changing is not implemented; this
backport uses the simple case changes available in those perls. */
#ifndef toUPPER_utf8_safe
# define toUPPER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(upper, s, e, r, l)
#endif
#ifndef toLOWER_utf8_safe
# define toLOWER_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(lower, s, e, r, l)
#endif
#ifndef toTITLE_utf8_safe
# define toTITLE_utf8_safe(s,e,r,l) \
D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(title, s, e, r, l)
#endif
/* Warning: toFOLD_utf8_safe, toFOLD_uvchr
The UTF-8 case changing operations had bugs before around 5.12 or 5.14;
this backport does not correct them.
In perls before 7.3, case folding is not implemented; instead, this
backport substitutes simple (not multi-character, which isn't available)
lowercasing. This gives the correct result in most, but not all, instances
*/
#ifndef toFOLD_utf8_safe
# define toFOLD_utf8_safe(s,e,r,l) toLOWER_utf8_safe(s,e,r,l)
#endif
#endif
/* Until we figure out how to support this in older perls... */
#if (PERL_BCDVERSION >= 0x5008000)
#ifndef HeUTF8
# define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
SvUTF8(HeKEY_sv(he)) : \
(U32)HeKUTF8(he))
#endif
#endif
#ifndef C_ARRAY_LENGTH
# define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
#endif
#ifndef C_ARRAY_END
# define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
( run in 0.535 second using v1.01-cache-2.11-cpan-39bf76dae61 )