summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorAndrew Fresh <afresh1@cvs.openbsd.org>2019-02-13 21:11:27 +0000
committerAndrew Fresh <afresh1@cvs.openbsd.org>2019-02-13 21:11:27 +0000
commit9c4d72b5838d846ff57d043af38123f6fdd647f8 (patch)
treeb79ce4dbe6aad930042f0265cab494fa28bc5903 /gnu
parent4a2754b54965650eb608560db11c4c99636110f0 (diff)
Import perl-5.28.1
looking good sthen@, Great! bluhm@
Diffstat (limited to 'gnu')
-rw-r--r--gnu/usr.bin/perl/dist/Devel-PPPort/parts/inc/misc2431
1 files changed, 121 insertions, 2310 deletions
diff --git a/gnu/usr.bin/perl/dist/Devel-PPPort/parts/inc/misc b/gnu/usr.bin/perl/dist/Devel-PPPort/parts/inc/misc
index deb1fb87a63..949c481088e 100644
--- a/gnu/usr.bin/perl/dist/Devel-PPPort/parts/inc/misc
+++ b/gnu/usr.bin/perl/dist/Devel-PPPort/parts/inc/misc
@@ -12,27 +12,43 @@
=provides
__UNDEFINED__
-END_EXTERN_C
-EXTERN_C
-INT2PTR
-MUTABLE_PTR
-NVTYPE
-PERLIO_FUNCS_CAST
-PERLIO_FUNCS_DECL
+PERL_UNUSED_DECL
PERL_UNUSED_ARG
+PERL_UNUSED_VAR
PERL_UNUSED_CONTEXT
-PERL_UNUSED_DECL
PERL_UNUSED_RESULT
-PERL_UNUSED_VAR
+PERL_GCC_BRACE_GROUPS_FORBIDDEN
PERL_USE_GCC_BRACE_GROUPS
-PTR2ul
+PERLIO_FUNCS_DECL
+PERLIO_FUNCS_CAST
+NVTYPE
+INT2PTR
PTRV
+NUM2PTR
+PERL_HASH
+PTR2IV
+PTR2UV
+PTR2NV
+PTR2ul
START_EXTERN_C
-STMT_END
+END_EXTERN_C
+EXTERN_C
STMT_START
-SvRX
+STMT_END
+UTF8_MAXBYTES
WIDEST_UTYPE
XSRETURN
+HeUTF8
+C_ARRAY_LENGTH
+C_ARRAY_END
+SvRX
+SvRXOK
+cBOOL
+OpHAS_SIBLING
+OpSIBLING
+OpMORESIB_set
+OpLASTSIB_set
+OpMAYBESIB_set
=implementation
@@ -42,91 +58,27 @@ __UNDEFINED__ OpSIBLING(o) (0 + (o)->op_sibling)
__UNDEFINED__ OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
__UNDEFINED__ OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
__UNDEFINED__ OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
-__UNDEFINED__ HEf_SVKEY -2
-#if defined(DEBUGGING) && !defined(__COVERITY__)
-__UNDEFINED__ __ASSERT_(statement) assert(statement),
-#else
-__UNDEFINED__ __ASSERT_(statement)
+#ifndef SvRX
+#if { NEED SvRX }
+
+void *
+SvRX(pTHX_ SV *rv)
+{
+ if (SvROK(rv)) {
+ SV *sv = SvRV(rv);
+ if (SvMAGICAL(sv)) {
+ MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
+ if (mg && mg->mg_obj) {
+ return mg->mg_obj;
+ }
+ }
+ }
+ return 0;
+}
+#endif
#endif
-/* These could become provided if/when they become part of the public API */
-__UNDEF_NOT_PROVIDED__ withinCOUNT(c, l, n) \
- (((WIDEST_UTYPE) (((c)) - ((l) | 0))) <= (((WIDEST_UTYPE) ((n) | 0))))
-__UNDEF_NOT_PROVIDED__ inRANGE(c, l, u) \
- ( (sizeof(c) == sizeof(U8)) ? withinCOUNT(((U8) (c)), (l), ((u) - (l))) \
- : (sizeof(c) == sizeof(U16)) ? withinCOUNT(((U16) (c)), (l), ((u) - (l))) \
- : (sizeof(c) == sizeof(U32)) ? withinCOUNT(((U32) (c)), (l), ((u) - (l))) \
- : (withinCOUNT(((WIDEST_UTYPE) (c)), (l), ((u) - (l)))))
-
-/* The '| 0' part ensures a compiler error if c is not integer (like e.g., a
- * pointer) */
-#undef FITS_IN_8_BITS /* handy.h version uses a core-only constant */
-__UNDEF_NOT_PROVIDED__ FITS_IN_8_BITS(c) ( (sizeof(c) == 1) \
- || !(((WIDEST_UTYPE)((c) | 0)) & ~0xFF))
-
-/* Create the macro for "is'macro'_utf8_safe(s, e)". For code points below
- * 256, it calls the equivalent _L1 macro by converting the UTF-8 to code
- * point. That is so that it can automatically get the bug fixes done in this
- * file. */
-#define D_PPP_IS_GENERIC_UTF8_SAFE(s, e, macro) \
- (((e) - (s)) <= 0 \
- ? 0 \
- : UTF8_IS_INVARIANT((s)[0]) \
- ? is ## macro ## _L1((s)[0]) \
- : (((e) - (s)) < UTF8SKIP(s)) \
- ? 0 \
- : UTF8_IS_DOWNGRADEABLE_START((s)[0]) \
- /* The cast in the line below is only to silence warnings */ \
- ? is ## macro ## _L1((WIDEST_UTYPE) LATIN1_TO_NATIVE( \
- UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \
- & UTF_START_MASK(2), \
- (s)[1]))) \
- : is ## macro ## _utf8(s))
-
-/* Create the macro for "is'macro'_LC_utf8_safe(s, e)". For code points below
- * 256, it calls the equivalent _L1 macro by converting the UTF-8 to code
- * point. That is so that it can automatically get the bug fixes done in this
- * file. */
-#define D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, macro) \
- (((e) - (s)) <= 0 \
- ? 0 \
- : UTF8_IS_INVARIANT((s)[0]) \
- ? is ## macro ## _LC((s)[0]) \
- : (((e) - (s)) < UTF8SKIP(s)) \
- ? 0 \
- : UTF8_IS_DOWNGRADEABLE_START((s)[0]) \
- /* The cast in the line below is only to silence warnings */ \
- ? is ## macro ## _LC((WIDEST_UTYPE) LATIN1_TO_NATIVE( \
- UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \
- & UTF_START_MASK(2), \
- (s)[1]))) \
- : is ## macro ## _utf8(s))
-
-/* A few of the early functions are broken. For these and the non-LC case,
- * machine generated code is substituted. But that code doesn't work for
- * locales. This is just like the above macro, but at the end, we call the
- * macro we've generated for the above 255 case, which is correct since locale
- * isn't involved. This will generate extra code to handle the 0-255 inputs,
- * but hopefully it will be optimized out by the C compiler. But just in case
- * it isn't, this macro is only used on the few versions that are broken */
-
-#define D_PPP_IS_GENERIC_LC_UTF8_SAFE_BROKEN(s, e, macro) \
- (((e) - (s)) <= 0 \
- ? 0 \
- : UTF8_IS_INVARIANT((s)[0]) \
- ? is ## macro ## _LC((s)[0]) \
- : (((e) - (s)) < UTF8SKIP(s)) \
- ? 0 \
- : UTF8_IS_DOWNGRADEABLE_START((s)[0]) \
- /* The cast in the line below is only to silence warnings */ \
- ? is ## macro ## _LC((WIDEST_UTYPE) LATIN1_TO_NATIVE( \
- UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \
- & UTF_START_MASK(2), \
- (s)[1]))) \
- : is ## macro ## _utf8_safe(s, e))
-
-__UNDEFINED__ SvRX(rv) (SvROK((rv)) ? (SvMAGICAL(SvRV((rv))) ? (mg_find(SvRV((rv)), PERL_MAGIC_qr) ? mg_find(SvRV((rv)), PERL_MAGIC_qr)->mg_obj : NULL) : NULL) : NULL)
__UNDEFINED__ SvRXOK(sv) (!!SvRX(sv))
#ifndef PERL_UNUSED_DECL
@@ -223,9 +175,9 @@ __UNDEFINED__ PTR2NV(p) NUM2PTR(NV,p)
# define EXTERN_C extern
#endif
-#if { VERSION < 5.004 } || defined(PERL_GCC_PEDANTIC)
+#if defined(PERL_GCC_PEDANTIC)
# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
-__UNDEF_NOT_PROVIDED__ PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
# endif
#endif
@@ -260,9 +212,6 @@ __UNDEFINED__ DEFSV_set(sv) (DEFSV = (sv))
/* Older perls (<=5.003) lack AvFILLp */
__UNDEFINED__ AvFILLp AvFILL
-__UNDEFINED__ av_tindex AvFILL
-__UNDEFINED__ av_top_index AvFILL
-
__UNDEFINED__ ERRSV get_sv("@",FALSE)
/* Hint: gv_stashpvn
@@ -313,6 +262,8 @@ __UNDEFINED__ dVAR dNOOP
__UNDEFINED__ SVf "_"
+__UNDEFINED__ UTF8_MAXBYTES UTF8_MAXLEN
+
__UNDEFINED__ CPERLscope(x) x
__UNDEFINED__ PERL_HASH(hash,str,len) \
@@ -348,6 +299,26 @@ typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
#endif
+__UNDEFINED__ isPSXSPC(c) (isSPACE(c) || (c) == '\v')
+__UNDEFINED__ isBLANK(c) ((c) == ' ' || (c) == '\t')
+#ifdef EBCDIC
+__UNDEFINED__ isALNUMC(c) isalnum(c)
+__UNDEFINED__ isASCII(c) isascii(c)
+__UNDEFINED__ isCNTRL(c) iscntrl(c)
+__UNDEFINED__ isGRAPH(c) isgraph(c)
+__UNDEFINED__ isPRINT(c) isprint(c)
+__UNDEFINED__ isPUNCT(c) ispunct(c)
+__UNDEFINED__ isXDIGIT(c) isxdigit(c)
+#else
+# if { VERSION < 5.10.0 }
+/* 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 WIDEST_UTYPE
# ifdef QUADKIND
# ifdef U64TYPE
@@ -360,696 +331,13 @@ typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
# endif
#endif
-/* On versions without NATIVE_TO_ASCII, only ASCII is supported */
-#if defined(EBCDIC) && defined(NATIVE_TO_ASCI)
-__UNDEFINED__ NATIVE_TO_LATIN1(c) NATIVE_TO_ASCII(c)
-__UNDEFINED__ LATIN1_TO_NATIVE(c) ASCII_TO_NATIVE(c)
-__UNDEFINED__ NATIVE_TO_UNI(c) ((c) > 255 ? (c) : NATIVE_TO_LATIN1(c))
-__UNDEFINED__ UNI_TO_NATIVE(c) ((c) > 255 ? (c) : LATIN1_TO_NATIVE(c))
-#else
-__UNDEFINED__ NATIVE_TO_LATIN1(c) (c)
-__UNDEFINED__ LATIN1_TO_NATIVE(c) (c)
-__UNDEFINED__ NATIVE_TO_UNI(c) (c)
-__UNDEFINED__ UNI_TO_NATIVE(c) (c)
-#endif
-
-/* Warning: LATIN1_TO_NATIVE, NATIVE_TO_LATIN1 NATIVE_TO_UNI UNI_TO_NATIVE
- EBCDIC is not supported on versions earlier than 5.7.1
- */
-
-/* The meaning of this changed; use the modern version */
-#undef isPSXSPC
-#undef isPSXSPC_A
-#undef isPSXSPC_L1
-
-/* Hint: isPSXSPC, isPSXSPC_A, isPSXSPC_L1, isPSXSPC_utf8_safe
- This is equivalent to the corresponding isSPACE-type macro. On perls
- before 5.18, this matched a vertical tab and SPACE didn't. But the
- ppport.h SPACE version does match VT in all perl releases. Since VT's are
- extremely rarely found in real-life files, this difference effectively
- doesn't matter */
-
-/* Hint: isSPACE, isSPACE_A, isSPACE_L1, isSPACE_utf8_safe
- Until Perl 5.18, this did not match the vertical tab (VT). The ppport.h
- version does match it in all perl releases. Since VT's are extremely rarely
- found in real-life files, this difference effectively doesn't matter */
-
-#ifdef EBCDIC
-
-/* This is the first version where these macros are fully correct on EBCDIC
- * platforms. Relying on * the C library functions, as earlier releases did,
- * causes problems with * locales */
-# if { VERSION < 5.22.0 }
-# undef isALNUM
-# undef isALNUM_A
-# undef isALNUM_L1
-# undef isALNUMC
-# undef isALNUMC_A
-# undef isALNUMC_L1
-# undef isALPHA
-# undef isALPHA_A
-# undef isALPHA_L1
-# undef isALPHANUMERIC
-# undef isALPHANUMERIC_A
-# undef isALPHANUMERIC_L1
-# undef isASCII
-# undef isASCII_A
-# undef isASCII_L1
-# undef isBLANK
-# undef isBLANK_A
-# undef isBLANK_L1
-# undef isCNTRL
-# undef isCNTRL_A
-# undef isCNTRL_L1
-# undef isDIGIT
-# undef isDIGIT_A
-# undef isDIGIT_L1
-# undef isGRAPH
-# undef isGRAPH_A
-# undef isGRAPH_L1
-# undef isIDCONT
-# undef isIDCONT_A
-# undef isIDCONT_L1
-# undef isIDFIRST
-# undef isIDFIRST_A
-# undef isIDFIRST_L1
-# undef isLOWER
-# undef isLOWER_A
-# undef isLOWER_L1
-# undef isOCTAL
-# undef isOCTAL_A
-# undef isOCTAL_L1
-# undef isPRINT
-# undef isPRINT_A
-# undef isPRINT_L1
-# undef isPUNCT
-# undef isPUNCT_A
-# undef isPUNCT_L1
-# undef isSPACE
-# undef isSPACE_A
-# undef isSPACE_L1
-# undef isUPPER
-# undef isUPPER_A
-# undef isUPPER_L1
-# undef isWORDCHAR
-# undef isWORDCHAR_A
-# undef isWORDCHAR_L1
-# undef isXDIGIT
-# undef isXDIGIT_A
-# undef isXDIGIT_L1
-# endif
-
-__UNDEFINED__ isASCII(c) (isCNTRL(c) || isPRINT(c))
-
- /* The below is accurate for all EBCDIC code pages supported by
- * all the versions of Perl overridden by this */
-__UNDEFINED__ isCNTRL(c) ( (c) == '\0' || (c) == '\a' || (c) == '\b' \
- || (c) == '\f' || (c) == '\n' || (c) == '\r' \
- || (c) == '\t' || (c) == '\v' \
- || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */ \
- || (c) == 7 /* U+7F DEL */ \
- || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */ \
- /* DLE, DC[1-3] */ \
- || (c) == 0x18 /* U+18 CAN */ \
- || (c) == 0x19 /* U+19 EOM */ \
- || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */ \
- || (c) == 0x26 /* U+17 ETB */ \
- || (c) == 0x27 /* U+1B ESC */ \
- || (c) == 0x2D /* U+05 ENQ */ \
- || (c) == 0x2E /* U+06 ACK */ \
- || (c) == 0x32 /* U+16 SYN */ \
- || (c) == 0x37 /* U+04 EOT */ \
- || (c) == 0x3C /* U+14 DC4 */ \
- || (c) == 0x3D /* U+15 NAK */ \
- || (c) == 0x3F /* U+1A SUB */ \
- )
-
-#if '^' == 106 /* EBCDIC POSIX-BC */
-# define D_PPP_OUTLIER_CONTROL 0x5F
-#else /* EBCDIC 1047 037 */
-# define D_PPP_OUTLIER_CONTROL 0xFF
-#endif
-
-/* The controls are everything below blank, plus one outlier */
-__UNDEFINED__ isCNTRL_L1(c) ((WIDEST_UTYPE) (c) < ' ' \
- || (WIDEST_UTYPE) (c) == D_PPP_OUTLIER_CONTROL)
-/* The ordering of the tests in this and isUPPER are to exclude most characters
- * early */
-__UNDEFINED__ isLOWER(c) ( (c) >= 'a' && (c) <= 'z' \
- && ( (c) <= 'i' \
- || ((c) >= 'j' && (c) <= 'r') \
- || (c) >= 's'))
-__UNDEFINED__ isUPPER(c) ( (c) >= 'A' && (c) <= 'Z' \
- && ( (c) <= 'I' \
- || ((c) >= 'J' && (c) <= 'R') \
- || (c) >= 'S'))
-
-#else /* Above is EBCDIC; below is ASCII */
-
-# if { VERSION < 5.4.0 }
-/* The implementation of these in older perl versions can give wrong results if
- * the C program locale is set to other than the C locale */
-# undef isALNUM
-# undef isALNUM_A
-# undef isALPHA
-# undef isALPHA_A
-# undef isDIGIT
-# undef isDIGIT_A
-# undef isIDFIRST
-# undef isIDFIRST_A
-# undef isLOWER
-# undef isLOWER_A
-# undef isUPPER
-# undef isUPPER_A
-# endif
-
-# if { VERSION == 5.7.0 } /* this perl made space GRAPH */
-# undef isGRAPH
-# endif
-
-# if { VERSION < 5.8.0 } /* earlier perls omitted DEL */
-# undef isCNTRL
-# endif
-
-# if { VERSION < 5.10.0 }
-/* earlier perls included all of the isSPACE() characters, which is wrong. The
- * version provided by Devel::PPPort always overrides an existing buggy
- * version. */
-# undef isPRINT
-# undef isPRINT_A
-# endif
-
-# if { VERSION < 5.14.0 }
-/* earlier perls always returned true if the parameter was a signed char */
-# undef isASCII
-# undef isASCII_A
-# endif
-
-# if { VERSION < 5.17.8 } /* earlier perls didn't include PILCROW, SECTION SIGN */
-# undef isPUNCT_L1
-# endif
-
-# if { VERSION < 5.13.7 } /* khw didn't investigate why this failed */
-# undef isALNUMC_L1
-#endif
-
-# if { VERSION < 5.20.0 } /* earlier perls didn't include \v */
-# undef isSPACE
-# undef isSPACE_A
-# undef isSPACE_L1
-
-# endif
-
+__UNDEFINED__ isALNUMC(c) (isALPHA(c) || isDIGIT(c))
__UNDEFINED__ isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
__UNDEFINED__ isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
-__UNDEFINED__ isCNTRL_L1(c) (isCNTRL(c) || ( (WIDEST_UTYPE) (c) <= 0x9F \
- && (WIDEST_UTYPE) (c) >= 0x80))
-__UNDEFINED__ isLOWER(c) ((c) >= 'a' && (c) <= 'z')
-__UNDEFINED__ isUPPER(c) ((c) <= 'Z' && (c) >= 'A')
-
-#endif /* Below are definitions common to EBCDIC and ASCII */
-
-__UNDEFINED__ isASCII_L1(c) isASCII(c)
-__UNDEFINED__ isASCII_LC(c) isASCII(c)
-__UNDEFINED__ isALNUM(c) isWORDCHAR(c)
-__UNDEFINED__ isALNUMC(c) isALPHANUMERIC(c)
-__UNDEFINED__ isALNUMC_L1(c) isALPHANUMERIC_L1(c)
-__UNDEFINED__ isALPHA(c) (isUPPER(c) || isLOWER(c))
-__UNDEFINED__ isALPHA_L1(c) (isUPPER_L1(c) || isLOWER_L1(c))
-__UNDEFINED__ isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c))
-__UNDEFINED__ isALPHANUMERIC_L1(c) (isALPHA_L1(c) || isDIGIT(c))
-__UNDEFINED__ isALPHANUMERIC_LC(c) (isALPHA_LC(c) || isDIGIT_LC(c))
-__UNDEFINED__ isBLANK(c) ((c) == ' ' || (c) == '\t')
-__UNDEFINED__ isBLANK_L1(c) ( isBLANK(c) \
- || ( FITS_IN_8_BITS(c) \
- && NATIVE_TO_LATIN1((U8) c) == 0xA0))
-__UNDEFINED__ isBLANK_LC(c) isBLANK(c)
-__UNDEFINED__ isDIGIT(c) inRANGE(c, '0', '9')
-__UNDEFINED__ isDIGIT_L1(c) isDIGIT(c)
-__UNDEFINED__ isGRAPH(c) (isWORDCHAR(c) || isPUNCT(c))
-__UNDEFINED__ isGRAPH_L1(c) ( isPRINT_L1(c) \
- && (c) != ' ' \
- && NATIVE_TO_LATIN1((U8) c) != 0xA0)
-__UNDEFINED__ isIDCONT(c) isWORDCHAR(c)
-__UNDEFINED__ isIDCONT_L1(c) isWORDCHAR_L1(c)
-__UNDEFINED__ isIDCONT_LC(c) isWORDCHAR_LC(c)
-__UNDEFINED__ isIDFIRST(c) (isALPHA(c) || (c) == '_')
-__UNDEFINED__ isIDFIRST_L1(c) (isALPHA_L1(c) || (U8) (c) == '_')
-__UNDEFINED__ isIDFIRST_LC(c) (isALPHA_LC(c) || (U8) (c) == '_')
-__UNDEFINED__ isLOWER_L1(c) ( isLOWER(c) \
- || ( FITS_IN_8_BITS(c) \
- && ( ( NATIVE_TO_LATIN1((U8) c) >= 0xDF \
- && NATIVE_TO_LATIN1((U8) c) != 0xF7) \
- || NATIVE_TO_LATIN1((U8) c) == 0xAA \
- || NATIVE_TO_LATIN1((U8) c) == 0xBA \
- || NATIVE_TO_LATIN1((U8) c) == 0xB5)))
-__UNDEFINED__ isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0')
-__UNDEFINED__ isOCTAL_L1(c) isOCTAL(c)
-__UNDEFINED__ isPRINT(c) (isGRAPH(c) || (c) == ' ')
-__UNDEFINED__ isPRINT_L1(c) (FITS_IN_8_BITS(c) && ! isCNTRL_L1(c))
-__UNDEFINED__ isPSXSPC(c) isSPACE(c)
-__UNDEFINED__ isPSXSPC_L1(c) isSPACE_L1(c)
-__UNDEFINED__ isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \
- || (c) == '#' || (c) == '$' || (c) == '%' \
- || (c) == '&' || (c) == '\'' || (c) == '(' \
- || (c) == ')' || (c) == '*' || (c) == '+' \
- || (c) == ',' || (c) == '.' || (c) == '/' \
- || (c) == ':' || (c) == ';' || (c) == '<' \
- || (c) == '=' || (c) == '>' || (c) == '?' \
- || (c) == '@' || (c) == '[' || (c) == '\\' \
- || (c) == ']' || (c) == '^' || (c) == '_' \
- || (c) == '`' || (c) == '{' || (c) == '|' \
- || (c) == '}' || (c) == '~')
-__UNDEFINED__ isPUNCT_L1(c) ( isPUNCT(c) \
- || ( FITS_IN_8_BITS(c) \
- && ( NATIVE_TO_LATIN1((U8) c) == 0xA1 \
- || NATIVE_TO_LATIN1((U8) c) == 0xA7 \
- || NATIVE_TO_LATIN1((U8) c) == 0xAB \
- || NATIVE_TO_LATIN1((U8) c) == 0xB6 \
- || NATIVE_TO_LATIN1((U8) c) == 0xB7 \
- || NATIVE_TO_LATIN1((U8) c) == 0xBB \
- || NATIVE_TO_LATIN1((U8) c) == 0xBF)))
-__UNDEFINED__ isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \
- || (c) == '\v' || (c) == '\f')
-__UNDEFINED__ isSPACE_L1(c) ( isSPACE(c) \
- || (FITS_IN_8_BITS(c) \
- && ( NATIVE_TO_LATIN1((U8) c) == 0x85 \
- || NATIVE_TO_LATIN1((U8) c) == 0xA0)))
-__UNDEFINED__ isUPPER_L1(c) ( isUPPER(c) \
- || (FITS_IN_8_BITS(c) \
- && ( NATIVE_TO_LATIN1((U8) c) >= 0xC0 \
- && NATIVE_TO_LATIN1((U8) c) <= 0xDE \
- && NATIVE_TO_LATIN1((U8) c) != 0xD7)))
-__UNDEFINED__ isWORDCHAR(c) (isALPHANUMERIC(c) || (c) == '_')
-__UNDEFINED__ isWORDCHAR_L1(c) (isIDFIRST_L1(c) || isDIGIT(c))
-__UNDEFINED__ isWORDCHAR_LC(c) (isIDFIRST_LC(c) || isDIGIT_LC(c))
-__UNDEFINED__ isXDIGIT(c) ( isDIGIT(c) \
- || ((c) >= 'a' && (c) <= 'f') \
- || ((c) >= 'A' && (c) <= 'F'))
-__UNDEFINED__ isXDIGIT_L1(c) isXDIGIT(c)
-__UNDEFINED__ isXDIGIT_LC(c) isxdigit(c)
-
-__UNDEFINED__ isALNUM_A(c) isALNUM(c)
-__UNDEFINED__ isALNUMC_A(c) isALNUMC(c)
-__UNDEFINED__ isALPHA_A(c) isALPHA(c)
-__UNDEFINED__ isALPHANUMERIC_A(c) isALPHANUMERIC(c)
-__UNDEFINED__ isASCII_A(c) isASCII(c)
-__UNDEFINED__ isBLANK_A(c) isBLANK(c)
-__UNDEFINED__ isCNTRL_A(c) isCNTRL(c)
-__UNDEFINED__ isDIGIT_A(c) isDIGIT(c)
-__UNDEFINED__ isGRAPH_A(c) isGRAPH(c)
-__UNDEFINED__ isIDCONT_A(c) isIDCONT(c)
-__UNDEFINED__ isIDFIRST_A(c) isIDFIRST(c)
-__UNDEFINED__ isLOWER_A(c) isLOWER(c)
-__UNDEFINED__ isOCTAL_A(c) isOCTAL(c)
-__UNDEFINED__ isPRINT_A(c) isPRINT(c)
-__UNDEFINED__ isPSXSPC_A(c) isPSXSPC(c)
-__UNDEFINED__ isPUNCT_A(c) isPUNCT(c)
-__UNDEFINED__ isSPACE_A(c) isSPACE(c)
-__UNDEFINED__ isUPPER_A(c) isUPPER(c)
-__UNDEFINED__ isWORDCHAR_A(c) isWORDCHAR(c)
-__UNDEFINED__ isXDIGIT_A(c) isXDIGIT(c)
-
-__UNDEFINED__ isASCII_utf8_safe(s,e) (((e) - (s)) <= 0 ? 0 : isASCII(*(s)))
-__UNDEFINED__ isASCII_uvchr(c) (FITS_IN_8_BITS(c) ? isASCII_L1(c) : 0)
-
-#if { VERSION >= 5.006 }
-# ifdef isALPHA_uni /* If one defined, all are; this is just an exemplar */
-# define D_PPP_is_ctype(upper, lower, c) \
- (FITS_IN_8_BITS(c) \
- ? is ## upper ## _L1(c) \
- : is ## upper ## _uni((UV) (c))) /* _uni is old synonym */
-# else
-# define D_PPP_is_ctype(upper, lower, c) \
- (FITS_IN_8_BITS(c) \
- ? is ## upper ## _L1(c) \
- : is_uni_ ## lower((UV) (c))) /* is_uni_ is even older */
-# endif
-
-__UNDEFINED__ isALPHA_uvchr(c) D_PPP_is_ctype(ALPHA, alpha, c)
-__UNDEFINED__ isALPHANUMERIC_uvchr(c) (isALPHA_uvchr(c) || isDIGIT_uvchr(c))
-# ifdef is_uni_blank
-__UNDEFINED__ isBLANK_uvchr(c) D_PPP_is_ctype(BLANK, blank, c)
-# else
-__UNDEFINED__ isBLANK_uvchr(c) (FITS_IN_8_BITS(c) \
- ? isBLANK_L1(c) \
- : ( (UV) (c) == 0x1680 /* Unicode 3.0 */ \
- || inRANGE((UV) (c), 0x2000, 0x200A) \
- || (UV) (c) == 0x202F /* Unicode 3.0 */\
- || (UV) (c) == 0x205F /* Unicode 3.2 */\
- || (UV) (c) == 0x3000))
-# endif
-__UNDEFINED__ isCNTRL_uvchr(c) D_PPP_is_ctype(CNTRL, cntrl, c)
-__UNDEFINED__ isDIGIT_uvchr(c) D_PPP_is_ctype(DIGIT, digit, c)
-__UNDEFINED__ isGRAPH_uvchr(c) D_PPP_is_ctype(GRAPH, graph, c)
-__UNDEFINED__ isIDCONT_uvchr(c) isWORDCHAR_uvchr(c)
-__UNDEFINED__ isIDFIRST_uvchr(c) D_PPP_is_ctype(IDFIRST, idfirst, c)
-__UNDEFINED__ isLOWER_uvchr(c) D_PPP_is_ctype(LOWER, lower, c)
-__UNDEFINED__ isPRINT_uvchr(c) D_PPP_is_ctype(PRINT, print, c)
-__UNDEFINED__ isPSXSPC_uvchr(c) isSPACE_uvchr(c)
-__UNDEFINED__ isPUNCT_uvchr(c) D_PPP_is_ctype(PUNCT, punct, c)
-__UNDEFINED__ isSPACE_uvchr(c) D_PPP_is_ctype(SPACE, space, c)
-__UNDEFINED__ isUPPER_uvchr(c) D_PPP_is_ctype(UPPER, upper, c)
-__UNDEFINED__ isXDIGIT_uvchr(c) D_PPP_is_ctype(XDIGIT, xdigit, c)
-__UNDEFINED__ isWORDCHAR_uvchr(c) (FITS_IN_8_BITS(c) \
- ? isWORDCHAR_L1(c) : isALPHANUMERIC_uvchr(c))
-
-__UNDEFINED__ isALPHA_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHA)
-# ifdef isALPHANUMERIC_utf8
-__UNDEFINED__ isALPHANUMERIC_utf8_safe(s,e) \
- D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHANUMERIC)
-# else
-__UNDEFINED__ isALPHANUMERIC_utf8_safe(s,e) \
- (isALPHA_utf8_safe(s,e) || isDIGIT_utf8_safe(s,e))
-# endif
-
-/* This was broken before 5.18, and just use this instead of worrying about
- * which releases the official works on */
-# if 'A' == 65
-__UNDEFINED__ isBLANK_utf8_safe(s,e) \
-( ( LIKELY((e) > (s)) ) ? /* Machine generated */ \
- ( ( 0x09 == ((const U8*)s)[0] || 0x20 == ((const U8*)s)[0] ) ? 1 \
- : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \
- ( ( 0xC2 == ((const U8*)s)[0] ) ? \
- ( ( 0xA0 == ((const U8*)s)[1] ) ? 2 : 0 ) \
- : ( 0xE1 == ((const U8*)s)[0] ) ? \
- ( ( ( 0x9A == ((const U8*)s)[1] ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
- : ( 0xE2 == ((const U8*)s)[0] ) ? \
- ( ( 0x80 == ((const U8*)s)[1] ) ? \
- ( ( inRANGE(((const U8*)s)[2], 0x80, 0x8A ) || 0xAF == ((const U8*)s)[2] ) ? 3 : 0 )\
- : ( ( 0x81 == ((const U8*)s)[1] ) && ( 0x9F == ((const U8*)s)[2] ) ) ? 3 : 0 )\
- : ( ( ( 0xE3 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
- : 0 ) \
- : 0 )
-
-# elif 'A' == 193 && '^' == 95 /* EBCDIC 1047 */
-
-__UNDEFINED__ isBLANK_utf8_safe(s,e) \
-( ( LIKELY((e) > (s)) ) ? \
- ( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1 \
- : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \
- ( ( 0x80 == ((const U8*)s)[0] ) ? \
- ( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 ) \
- : ( 0xBC == ((const U8*)s)[0] ) ? \
- ( ( ( 0x63 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
- : ( 0xCA == ((const U8*)s)[0] ) ? \
- ( ( 0x41 == ((const U8*)s)[1] ) ? \
- ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\
- : ( 0x42 == ((const U8*)s)[1] ) ? \
- ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 ) \
- : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x73 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
- : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
- : 0 ) \
-: 0 )
-
-# elif 'A' == 193 && '^' == 176 /* EBCDIC 037 */
-
-__UNDEFINED__ isBLANK_utf8_safe(s,e) \
-( ( LIKELY((e) > (s)) ) ? \
- ( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1 \
- : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \
- ( ( 0x78 == ((const U8*)s)[0] ) ? \
- ( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 ) \
- : ( 0xBD == ((const U8*)s)[0] ) ? \
- ( ( ( 0x62 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
- : ( 0xCA == ((const U8*)s)[0] ) ? \
- ( ( 0x41 == ((const U8*)s)[1] ) ? \
- ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\
- : ( 0x42 == ((const U8*)s)[1] ) ? \
- ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 ) \
- : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
- : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\
- : 0 ) \
-: 0 )
-
-# else
-# error Unknown character set
-# endif
-
-__UNDEFINED__ isCNTRL_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, CNTRL)
-__UNDEFINED__ isDIGIT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, DIGIT)
-__UNDEFINED__ isGRAPH_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, GRAPH)
-# ifdef isIDCONT_utf8
-__UNDEFINED__ isIDCONT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDCONT)
-# else
-__UNDEFINED__ isIDCONT_utf8_safe(s,e) isWORDCHAR_utf8_safe(s,e)
-# endif
-
-__UNDEFINED__ isIDFIRST_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDFIRST)
-__UNDEFINED__ isLOWER_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, LOWER)
-__UNDEFINED__ isPRINT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PRINT)
-
-# undef isPSXSPC_utf8_safe /* Use the modern definition */
-__UNDEFINED__ isPSXSPC_utf8_safe(s,e) isSPACE_utf8_safe(s,e)
-
-__UNDEFINED__ isPUNCT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PUNCT)
-__UNDEFINED__ isSPACE_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, SPACE)
-__UNDEFINED__ isUPPER_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, UPPER)
-
-# ifdef isWORDCHAR_utf8
-__UNDEFINED__ isWORDCHAR_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, WORDCHAR)
-# else
-__UNDEFINED__ isWORDCHAR_utf8_safe(s,e) \
- (isALPHANUMERIC_utf8_safe(s,e) || (*(s)) == '_')
-# endif
-
-/* This was broken before 5.12, and just use this instead of worrying about
- * which releases the official works on */
-# if 'A' == 65
-__UNDEFINED__ isXDIGIT_utf8_safe(s,e) \
-( ( LIKELY((e) > (s)) ) ? \
- ( ( inRANGE(((const U8*)s)[0], 0x30, 0x39 ) || inRANGE(((const U8*)s)[0], 0x41, 0x46 ) || inRANGE(((const U8*)s)[0], 0x61, 0x66 ) ) ? 1\
- : ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xEF == ((const U8*)s)[0] ) ) ? ( ( 0xBC == ((const U8*)s)[1] ) ?\
- ( ( inRANGE(((const U8*)s)[2], 0x90, 0x99 ) || inRANGE(((const U8*)s)[2], 0xA1, 0xA6 ) ) ? 3 : 0 )\
- : ( ( 0xBD == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x81, 0x86 ) ) ) ? 3 : 0 ) : 0 )\
-: 0 )
-
-# elif 'A' == 193 && '^' == 95 /* EBCDIC 1047 */
-
-__UNDEFINED__ isXDIGIT_utf8_safe(s,e) \
-( ( LIKELY((e) > (s)) ) ? \
- ( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\
- : ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x73 == ((const U8*)s)[1] ) ) ? ( ( 0x67 == ((const U8*)s)[2] ) ?\
- ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || inRANGE(((const U8*)s)[3], 0x62, 0x68 ) ) ? 4 : 0 )\
- : ( ( inRANGE(((const U8*)s)[2], 0x68, 0x69 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
-: 0 )
-
-# elif 'A' == 193 && '^' == 176 /* EBCDIC 037 */
-
-__UNDEFINED__ isXDIGIT_utf8_safe(s,e) \
-( ( LIKELY((e) > (s)) ) ? \
- ( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\
- : ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x72 == ((const U8*)s)[1] ) ) ? ( ( 0x66 == ((const U8*)s)[2] ) ?\
- ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x67 ) ) ? 4 : 0 )\
- : ( ( inRANGE(((const U8*)s)[2], 0x67, 0x68 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
-: 0 )
-
-# else
-# error Unknown character set
-# endif
-
-__UNDEFINED__ isALPHA_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, ALPHA)
-# ifdef isALPHANUMERIC_utf8
-__UNDEFINED__ isALPHANUMERIC_LC_utf8_safe(s,e) \
- D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, ALPHANUMERIC)
-# else
-__UNDEFINED__ isALPHANUMERIC_LC_utf8_safe(s,e) \
- (isALPHA_LC_utf8_safe(s,e) || isDIGIT_LC_utf8_safe(s,e))
-# endif
-
-__UNDEFINED__ isBLANK_LC_utf8_safe(s,e) \
- D_PPP_IS_GENERIC_LC_UTF8_SAFE_BROKEN(s, e, BLANK)
-__UNDEFINED__ isCNTRL_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, CNTRL)
-__UNDEFINED__ isDIGIT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, DIGIT)
-__UNDEFINED__ isGRAPH_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, GRAPH)
-# ifdef isIDCONT_utf8
-__UNDEFINED__ isIDCONT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, IDCONT)
-# else
-__UNDEFINED__ isIDCONT_LC_utf8_safe(s,e) isWORDCHAR_LC_utf8_safe(s,e)
-# endif
-
-__UNDEFINED__ isIDFIRST_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, IDFIRST)
-__UNDEFINED__ isLOWER_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, LOWER)
-__UNDEFINED__ isPRINT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, PRINT)
-
-# undef isPSXSPC_LC_utf8_safe /* Use the modern definition */
-__UNDEFINED__ isPSXSPC_LC_utf8_safe(s,e) isSPACE_LC_utf8_safe(s,e)
-
-__UNDEFINED__ isPUNCT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, PUNCT)
-__UNDEFINED__ isSPACE_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, SPACE)
-__UNDEFINED__ isUPPER_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, UPPER)
-
-# ifdef isWORDCHAR_utf8
-__UNDEFINED__ isWORDCHAR_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, WORDCHAR)
-# else
-__UNDEFINED__ isWORDCHAR_LC_utf8_safe(s,e) \
- (isALPHANUMERIC_LC_utf8_safe(s,e) || (*(s)) == '_')
-# endif
-
-__UNDEFINED__ isXDIGIT_LC_utf8_safe(s,e) \
- D_PPP_IS_GENERIC_LC_UTF8_SAFE_BROKEN(s, e, XDIGIT)
-
-/* Warning: isALPHANUMERIC_utf8_safe, isALPHA_utf8_safe, isASCII_utf8_safe,
- * isBLANK_utf8_safe, isCNTRL_utf8_safe, isDIGIT_utf8_safe, isGRAPH_utf8_safe,
- * isIDCONT_utf8_safe, isIDFIRST_utf8_safe, isLOWER_utf8_safe,
- * isPRINT_utf8_safe, isPSXSPC_utf8_safe, isPUNCT_utf8_safe, isSPACE_utf8_safe,
- * isUPPER_utf8_safe, isWORDCHAR_utf8_safe, isWORDCHAR_utf8_safe,
- * isXDIGIT_utf8_safe,
- * isALPHANUMERIC_LC_utf8_safe, isALPHA_LC_utf8_safe, isASCII_LC_utf8_safe,
- * isBLANK_LC_utf8_safe, isCNTRL_LC_utf8_safe, isDIGIT_LC_utf8_safe,
- * isGRAPH_LC_utf8_safe, isIDCONT_LC_utf8_safe, isIDFIRST_LC_utf8_safe,
- * isLOWER_LC_utf8_safe, isPRINT_LC_utf8_safe, isPSXSPC_LC_utf8_safe,
- * isPUNCT_LC_utf8_safe, isSPACE_LC_utf8_safe, isUPPER_LC_utf8_safe,
- * isWORDCHAR_LC_utf8_safe, isWORDCHAR_LC_utf8_safe, isXDIGIT_LC_utf8_safe,
- * isALPHANUMERIC_uvchr, isALPHA_uvchr, isASCII_uvchr, isBLANK_uvchr,
- * isCNTRL_uvchr, isDIGIT_uvchr, isGRAPH_uvchr, isIDCONT_uvchr,
- * isIDFIRST_uvchr, isLOWER_uvchr, isPRINT_uvchr, isPSXSPC_uvchr,
- * isPUNCT_uvchr, isSPACE_uvchr, isUPPER_uvchr, isWORDCHAR_uvchr,
- * isWORDCHAR_uvchr, isXDIGIT_uvchr
- *
- * The UTF-8 handling is buggy in early Perls, and this can give inaccurate
- * results for code points above 0xFF, until the implementation started
- * settling down in 5.12 and 5.14 */
-
-#endif
-
-#define D_PPP_TOO_SHORT_MSG "Malformed UTF-8 character starting with:" \
- " \\x%02x (too short; %d bytes available, need" \
- " %d)\n"
-/* Perls starting here had a new API which handled multi-character results */
-#if { VERSION >= 5.7.3 }
-
-__UNDEFINED__ toLOWER_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_lower(NATIVE_TO_UNI(c), s, l))
-__UNDEFINED__ toUPPER_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_upper(NATIVE_TO_UNI(c), s, l))
-__UNDEFINED__ toTITLE_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_title(NATIVE_TO_UNI(c), s, l))
-__UNDEFINED__ toFOLD_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_fold( NATIVE_TO_UNI(c), s, l))
-
-# if { VERSION != 5.15.6 } /* 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))
-
-__UNDEFINED__ toUPPER_utf8_safe(s,e,r,l) \
- D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l)
-__UNDEFINED__ toLOWER_utf8_safe(s,e,r,l) \
- D_PPP_GENERIC_MULTI_ARG_TO(LOWER,s,e,r,l)
-__UNDEFINED__ toTITLE_utf8_safe(s,e,r,l) \
- D_PPP_GENERIC_MULTI_ARG_TO(TITLE,s,e,r,l)
-__UNDEFINED__ toFOLD_utf8_safe(s,e,r,l) \
- D_PPP_GENERIC_MULTI_ARG_TO(FOLD,s,e,r,l)
-
-#elif { VERSION >= 5.006 }
-
-/* 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))))
-
-__UNDEFINED__ toLOWER_uvchr(c, s, l) \
- D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(lower, c, s, l)
-__UNDEFINED__ toUPPER_uvchr(c, s, l) \
- D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(upper, c, s, l)
-__UNDEFINED__ toTITLE_uvchr(c, s, l) \
- D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l)
-__UNDEFINED__ toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
-
-# 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. */
-
-__UNDEFINED__ toUPPER_utf8_safe(s,e,r,l) \
- D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(upper, s, e, r, l)
-__UNDEFINED__ toLOWER_utf8_safe(s,e,r,l) \
- D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(lower, s, e, r, l)
-__UNDEFINED__ toTITLE_utf8_safe(s,e,r,l) \
- D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(title, s, e, r, l)
-
- /* 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
- */
-
-__UNDEFINED__ toFOLD_utf8_safe(s,e,r,l) toLOWER_utf8_safe(s,e,r,l)
-
+__UNDEFINED__ isGRAPH(c) (isALNUM(c) || isPUNCT(c))
+__UNDEFINED__ isPRINT(c) (((c) >= 32 && (c) < 127))
+__UNDEFINED__ isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
+__UNDEFINED__ isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
#endif
/* Until we figure out how to support this in older perls... */
@@ -1064,19 +352,6 @@ __UNDEFINED__ HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
__UNDEFINED__ C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
__UNDEFINED__ C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
-__UNDEFINED__ LIKELY(x) (x)
-__UNDEFINED__ UNLIKELY(x) (x)
-
-#ifndef MUTABLE_PTR
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
-#else
-# define MUTABLE_PTR(p) ((void *) (p))
-#endif
-#endif
-
-__UNDEFINED__ MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
-
=xsmisc
typedef XSPROTO(XSPROTO_test_t);
@@ -1111,6 +386,10 @@ XS(XS_Devel__PPPort_dAXMARK)
XSRETURN(1);
}
+=xsinit
+
+#define NEED_SvRX
+
=xsboot
{
@@ -1126,7 +405,6 @@ OpSIBLING_tests()
PREINIT:
OP *x;
OP *kid;
- OP *middlekid;
OP *lastkid;
int count = 0;
int failures = 0;
@@ -1150,7 +428,6 @@ OpSIBLING_tests()
kid = OpSIBLING(kid);
lastkid = kid;
}
- middlekid = OpSIBLING(x);
/* Should now have a sibling */
if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) {
@@ -1194,9 +471,6 @@ OpSIBLING_tests()
failures++; warn("Op should have had a sib after maybesibset");
}
- op_free(lastkid);
- op_free(middlekid);
- op_free(x);
RETVAL = failures;
OUTPUT:
RETVAL
@@ -1316,7 +590,7 @@ DEFSV_modify()
int
ERRSV()
CODE:
- RETVAL = SvTRUEx(ERRSV);
+ RETVAL = SvTRUE(ERRSV);
OUTPUT:
RETVAL
@@ -1402,1169 +676,44 @@ check_c_array()
mXPUSHi(C_ARRAY_LENGTH(x)); /* 4 */
mXPUSHi(*(C_ARRAY_END(x)-1)); /* 13 */
-bool
-isBLANK(ord)
- UV ord
- CODE:
- RETVAL = isBLANK(ord);
- OUTPUT:
- RETVAL
-
-bool
-isBLANK_A(ord)
- UV ord
- CODE:
- RETVAL = isBLANK_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isBLANK_L1(ord)
- UV ord
- CODE:
- RETVAL = isBLANK_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isUPPER(ord)
- UV ord
- CODE:
- RETVAL = isUPPER(ord);
- OUTPUT:
- RETVAL
-
-bool
-isUPPER_A(ord)
- UV ord
- CODE:
- RETVAL = isUPPER_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isUPPER_L1(ord)
- UV ord
- CODE:
- RETVAL = isUPPER_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isLOWER(ord)
- UV ord
- CODE:
- RETVAL = isLOWER(ord);
- OUTPUT:
- RETVAL
-
-bool
-isLOWER_A(ord)
- UV ord
- CODE:
- RETVAL = isLOWER_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isLOWER_L1(ord)
- UV ord
- CODE:
- RETVAL = isLOWER_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALPHA(ord)
- UV ord
- CODE:
- RETVAL = isALPHA(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALPHA_A(ord)
- UV ord
- CODE:
- RETVAL = isALPHA_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALPHA_L1(ord)
- UV ord
- CODE:
- RETVAL = isALPHA_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isWORDCHAR(ord)
- UV ord
- CODE:
- RETVAL = isWORDCHAR(ord);
- OUTPUT:
- RETVAL
-
-bool
-isWORDCHAR_A(ord)
- UV ord
- CODE:
- RETVAL = isWORDCHAR_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isWORDCHAR_L1(ord)
- UV ord
- CODE:
- RETVAL = isWORDCHAR_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALPHANUMERIC(ord)
- UV ord
- CODE:
- RETVAL = isALPHANUMERIC(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALPHANUMERIC_A(ord)
- UV ord
- CODE:
- RETVAL = isALPHANUMERIC_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALNUM(ord)
- UV ord
- CODE:
- RETVAL = isALNUM(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALNUM_A(ord)
- UV ord
- CODE:
- RETVAL = isALNUM_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isDIGIT(ord)
- UV ord
- CODE:
- RETVAL = isDIGIT(ord);
- OUTPUT:
- RETVAL
-
-bool
-isDIGIT_A(ord)
- UV ord
- CODE:
- RETVAL = isDIGIT_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isOCTAL(ord)
- UV ord
- CODE:
- RETVAL = isOCTAL(ord);
- OUTPUT:
- RETVAL
-
-bool
-isOCTAL_A(ord)
- UV ord
- CODE:
- RETVAL = isOCTAL_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isIDFIRST(ord)
- UV ord
- CODE:
- RETVAL = isIDFIRST(ord);
- OUTPUT:
- RETVAL
-
-bool
-isIDFIRST_A(ord)
- UV ord
- CODE:
- RETVAL = isIDFIRST_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isIDCONT(ord)
- UV ord
- CODE:
- RETVAL = isIDCONT(ord);
- OUTPUT:
- RETVAL
-
-bool
-isIDCONT_A(ord)
- UV ord
- CODE:
- RETVAL = isIDCONT_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isSPACE(ord)
- UV ord
- CODE:
- RETVAL = isSPACE(ord);
- OUTPUT:
- RETVAL
-
-bool
-isSPACE_A(ord)
- UV ord
- CODE:
- RETVAL = isSPACE_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isASCII(ord)
- UV ord
- CODE:
- RETVAL = isASCII(ord);
- OUTPUT:
- RETVAL
-
-bool
-isASCII_A(ord)
- UV ord
- CODE:
- RETVAL = isASCII_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isCNTRL(ord)
- UV ord
- CODE:
- RETVAL = isCNTRL(ord);
- OUTPUT:
- RETVAL
-
-bool
-isCNTRL_A(ord)
- UV ord
- CODE:
- RETVAL = isCNTRL_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPRINT(ord)
- UV ord
- CODE:
- RETVAL = isPRINT(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPRINT_A(ord)
- UV ord
- CODE:
- RETVAL = isPRINT_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isGRAPH(ord)
- UV ord
- CODE:
- RETVAL = isGRAPH(ord);
- OUTPUT:
- RETVAL
-
-bool
-isGRAPH_A(ord)
- UV ord
- CODE:
- RETVAL = isGRAPH_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPUNCT(ord)
- UV ord
- CODE:
- RETVAL = isPUNCT(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPUNCT_A(ord)
- UV ord
- CODE:
- RETVAL = isPUNCT_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isXDIGIT(ord)
- UV ord
- CODE:
- RETVAL = isXDIGIT(ord);
- OUTPUT:
- RETVAL
-
-bool
-isXDIGIT_A(ord)
- UV ord
- CODE:
- RETVAL = isXDIGIT_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPSXSPC(ord)
- UV ord
- CODE:
- RETVAL = isPSXSPC(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPSXSPC_A(ord)
- UV ord
- CODE:
- RETVAL = isPSXSPC_A(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALPHANUMERIC_L1(ord)
- UV ord
- CODE:
- RETVAL = isALPHANUMERIC_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALNUMC_L1(ord)
- UV ord
- CODE:
- RETVAL = isALNUMC_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isDIGIT_L1(ord)
- UV ord
- CODE:
- RETVAL = isDIGIT_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isOCTAL_L1(ord)
- UV ord
- CODE:
- RETVAL = isOCTAL_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isIDFIRST_L1(ord)
- UV ord
- CODE:
- RETVAL = isIDFIRST_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isIDCONT_L1(ord)
- UV ord
- CODE:
- RETVAL = isIDCONT_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isSPACE_L1(ord)
- UV ord
- CODE:
- RETVAL = isSPACE_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isASCII_L1(ord)
- UV ord
- CODE:
- RETVAL = isASCII_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isCNTRL_L1(ord)
- UV ord
- CODE:
- RETVAL = isCNTRL_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPRINT_L1(ord)
- UV ord
- CODE:
- RETVAL = isPRINT_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isGRAPH_L1(ord)
- UV ord
- CODE:
- RETVAL = isGRAPH_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPUNCT_L1(ord)
- UV ord
- CODE:
- RETVAL = isPUNCT_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isXDIGIT_L1(ord)
- UV ord
- CODE:
- RETVAL = isXDIGIT_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPSXSPC_L1(ord)
- UV ord
- CODE:
- RETVAL = isPSXSPC_L1(ord);
- OUTPUT:
- RETVAL
-
-bool
-isASCII_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isASCII_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isASCII_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- PERL_UNUSED_ARG(offset);
- RETVAL = isASCII_utf8_safe(s, s + 1 + offset);
- OUTPUT:
- RETVAL
-
-#if { VERSION >= 5.006 }
-
-bool
-isBLANK_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isBLANK_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALPHA_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isALPHA_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALPHANUMERIC_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isALPHANUMERIC_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isCNTRL_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isCNTRL_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isDIGIT_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isDIGIT_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isIDFIRST_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isIDFIRST_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isIDCONT_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isIDCONT_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isGRAPH_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isGRAPH_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isLOWER_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isLOWER_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPRINT_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isPRINT_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPSXSPC_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isPSXSPC_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isPUNCT_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isPUNCT_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isSPACE_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isSPACE_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isUPPER_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isUPPER_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isWORDCHAR_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isWORDCHAR_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isXDIGIT_uvchr(ord)
- UV ord
- CODE:
- RETVAL = isXDIGIT_uvchr(ord);
- OUTPUT:
- RETVAL
-
-bool
-isALPHA_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isALPHA_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isALPHANUMERIC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isALPHANUMERIC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isBLANK_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isBLANK_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isCNTRL_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isCNTRL_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isDIGIT_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isDIGIT_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isGRAPH_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isGRAPH_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isIDCONT_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isIDCONT_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isIDFIRST_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isIDFIRST_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isLOWER_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isLOWER_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isPRINT_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isPRINT_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isPSXSPC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isPSXSPC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isPUNCT_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isPUNCT_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isSPACE_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isSPACE_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isUPPER_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isUPPER_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isWORDCHAR_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isWORDCHAR_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isXDIGIT_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isXDIGIT_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isALPHA_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isALPHA_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isALPHANUMERIC_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isALPHANUMERIC_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isASCII_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- PERL_UNUSED_ARG(offset);
- RETVAL = isASCII_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isBLANK_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isBLANK_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isCNTRL_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isCNTRL_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isDIGIT_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isDIGIT_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isGRAPH_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isGRAPH_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isIDCONT_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isIDCONT_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isIDFIRST_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isIDFIRST_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isLOWER_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isLOWER_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isPRINT_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isPRINT_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isPSXSPC_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isPSXSPC_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isPUNCT_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isPUNCT_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isSPACE_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isSPACE_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isUPPER_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isUPPER_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isWORDCHAR_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isWORDCHAR_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-bool
-isXDIGIT_LC_utf8_safe(s, offset)
- unsigned char * s
- int offset
- CODE:
- RETVAL = isXDIGIT_LC_utf8_safe(s, s + UTF8SKIP(s) + offset);
- OUTPUT:
- RETVAL
-
-AV *
-toLOWER_utf8_safe(s, offset)
- unsigned char * s
- int offset
- PREINIT:
- U8 u[UTF8_MAXBYTES+1];
- Size_t len;
- UV ret;
- SV* utf8;
- AV * av;
- CODE:
- av = newAV();
- ret = toLOWER_utf8_safe(s, s + UTF8SKIP(s) + offset, u, &len);
- av_push(av, newSVuv(ret));
-
- utf8 = newSVpvn((char *) u, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
- OUTPUT:
- RETVAL
-
-AV *
-toTITLE_utf8_safe(s, offset)
- unsigned char * s
- int offset
- PREINIT:
- U8 u[UTF8_MAXBYTES+1];
- Size_t len;
- UV ret;
- SV* utf8;
- AV * av;
- CODE:
- av = newAV();
- ret = toTITLE_utf8_safe(s, s + UTF8SKIP(s) + offset, u, &len);
- av_push(av, newSVuv(ret));
-
- utf8 = newSVpvn((char *) u, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
- OUTPUT:
- RETVAL
-
-AV *
-toUPPER_utf8_safe(s, offset)
- unsigned char * s
- int offset
- PREINIT:
- U8 u[UTF8_MAXBYTES+1];
- Size_t len;
- UV ret;
- SV* utf8;
- AV * av;
- CODE:
- av = newAV();
- ret = toUPPER_utf8_safe(s, s + UTF8SKIP(s) + offset, u, &len);
- av_push(av, newSVuv(ret));
-
- utf8 = newSVpvn((char *) u, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
- OUTPUT:
- RETVAL
-
-AV *
-toFOLD_utf8_safe(s, offset)
- unsigned char * s
- int offset
- PREINIT:
- U8 u[UTF8_MAXBYTES+1];
- Size_t len;
- UV ret;
- SV* utf8;
- AV * av;
- CODE:
- av = newAV();
- ret = toFOLD_utf8_safe(s, s + UTF8SKIP(s) + offset, u, &len);
- av_push(av, newSVuv(ret));
-
- utf8 = newSVpvn((char *) u, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
- OUTPUT:
- RETVAL
-
-AV *
-toLOWER_uvchr(c)
- UV c
- PREINIT:
- U8 u[UTF8_MAXBYTES+1];
- Size_t len;
- UV ret;
- SV* utf8;
- AV * av;
- CODE:
- av = newAV();
- ret = toLOWER_uvchr(c, u, &len);
- av_push(av, newSVuv(ret));
-
- utf8 = newSVpvn((char *) u, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
- OUTPUT:
- RETVAL
-
-AV *
-toTITLE_uvchr(c)
- UV c
- PREINIT:
- U8 u[UTF8_MAXBYTES+1];
- Size_t len;
- UV ret;
- SV* utf8;
- AV * av;
- CODE:
- av = newAV();
- ret = toTITLE_uvchr(c, u, &len);
- av_push(av, newSVuv(ret));
-
- utf8 = newSVpvn((char *) u, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
- OUTPUT:
- RETVAL
-
-AV *
-toUPPER_uvchr(c)
- UV c
- PREINIT:
- U8 u[UTF8_MAXBYTES+1];
- Size_t len;
- UV ret;
- SV* utf8;
- AV * av;
- CODE:
- av = newAV();
- ret = toUPPER_uvchr(c, u, &len);
- av_push(av, newSVuv(ret));
-
- utf8 = newSVpvn((char *) u, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
- OUTPUT:
- RETVAL
-
-AV *
-toFOLD_uvchr(c)
- UV c
- PREINIT:
- U8 u[UTF8_MAXBYTES+1];
- Size_t len;
- UV ret;
- SV* utf8;
- AV * av;
- CODE:
- av = newAV();
- ret = toFOLD_uvchr(c, u, &len);
- av_push(av, newSVuv(ret));
-
- utf8 = newSVpvn((char *) u, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
- OUTPUT:
- RETVAL
-
-#endif
-
-UV
-LATIN1_TO_NATIVE(cp)
- UV cp
- CODE:
- if (cp > 255) RETVAL= cp;
- else RETVAL= LATIN1_TO_NATIVE(cp);
- OUTPUT:
- RETVAL
-
-UV
-NATIVE_TO_LATIN1(cp)
- UV cp
- CODE:
- RETVAL= NATIVE_TO_LATIN1(cp);
- OUTPUT:
- RETVAL
-
-STRLEN
-av_tindex(av)
- SV *av
- CODE:
- RETVAL = av_tindex((AV*)SvRV(av));
- OUTPUT:
- RETVAL
-
-STRLEN
-av_top_index(av)
- SV *av
- CODE:
- RETVAL = av_top_index((AV*)SvRV(av));
- OUTPUT:
- RETVAL
-
-=tests plan => 26826
+=tests plan => 48
use vars qw($my_sv @my_av %my_hv);
-ok(&Devel::PPPort::boolSV(1), "Verify boolSV(1) is true");
-ok(!&Devel::PPPort::boolSV(0), "Verify boolSV(0) is false");
+ok(&Devel::PPPort::boolSV(1));
+ok(!&Devel::PPPort::boolSV(0));
$_ = "Fred";
-is(&Devel::PPPort::DEFSV(), "Fred", '$_ is FRED; Verify DEFSV is FRED');
-is(&Devel::PPPort::UNDERBAR(), "Fred", 'And verify UNDERBAR is FRED');
+ok(&Devel::PPPort::DEFSV(), "Fred");
+ok(&Devel::PPPort::UNDERBAR(), "Fred");
-if (ivers($]) >= ivers(5.9.2) && ivers($]) < ivers(5.23)) {
+if ($] >= 5.009002 && $] < 5.023 && $] < 5.023004) {
eval q{
no warnings "deprecated";
- no if $^V >= v5.17.9, warnings => "experimental::lexical_topic";
+ no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
my $_ = "Tony";
- is(&Devel::PPPort::DEFSV(), "Fred", 'lexical_topic eval: $_ is Tony; Verify DEFSV is Fred');
- is(&Devel::PPPort::UNDERBAR(), "Tony", 'And verify UNDERBAR is Tony');
+ ok(&Devel::PPPort::DEFSV(), "Fred");
+ ok(&Devel::PPPort::UNDERBAR(), "Tony");
};
- die __FILE__ . __LINE__ . ": $@" if $@;
}
else {
- skip("perl version outside testing range of lexical_topic", 2);
+ ok(1);
+ ok(1);
}
my @r = &Devel::PPPort::DEFSV_modify();
-ok(@r == 3, "Verify got 3 elements");
-is($r[0], 'Fred');
-is($r[1], 'DEFSV');
-is($r[2], 'Fred');
+ok(@r == 3);
+ok($r[0], 'Fred');
+ok($r[1], 'DEFSV');
+ok($r[2], 'Fred');
-is(&Devel::PPPort::DEFSV(), "Fred");
+ok(&Devel::PPPort::DEFSV(), "Fred");
eval { 1 };
-ok(!&Devel::PPPort::ERRSV(), "Verify ERRSV on true is false");
+ok(!&Devel::PPPort::ERRSV());
eval { cannot_call_this_one() };
-ok(&Devel::PPPort::ERRSV(), "Verify ERRSV on false is true");
+ok(&Devel::PPPort::ERRSV());
ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
@@ -2590,386 +739,48 @@ ok(&Devel::PPPort::get_cv('my_cv', 0));
ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
ok(&Devel::PPPort::get_cv('not_my_cv', 1));
-is(Devel::PPPort::dXSTARG(42), 43);
-is(Devel::PPPort::dAXMARK(4711), 4710);
+ok(Devel::PPPort::dXSTARG(42), 43);
+ok(Devel::PPPort::dAXMARK(4711), 4710);
-is(Devel::PPPort::prepush(), 42);
+ok(Devel::PPPort::prepush(), 42);
-is(join(':', Devel::PPPort::xsreturn(0)), 'test1');
-is(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
+ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
+ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
-is(Devel::PPPort::PERL_ABS(42), 42, "Verify PERL_ABS(42) is 42");
-is(Devel::PPPort::PERL_ABS(-13), 13, "Verify PERL_ABS(-13) is 13");
+ok(Devel::PPPort::PERL_ABS(42), 42);
+ok(Devel::PPPort::PERL_ABS(-13), 13);
-is(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42');
-is(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc');
+ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42');
+ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc');
-is(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
+ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
-is(&Devel::PPPort::ptrtests(), 63);
+ok(&Devel::PPPort::ptrtests(), 63);
-is(&Devel::PPPort::OpSIBLING_tests(), 0);
+ok(&Devel::PPPort::OpSIBLING_tests(), 0);
-if (ivers($]) >= ivers(5.9)) {
+if ($] >= 5.009000) {
eval q{
- is(&Devel::PPPort::check_HeUTF8("hello"), "norm");
- is(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
+ ok(&Devel::PPPort::check_HeUTF8("hello"), "norm");
+ ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
};
} else {
- skip("Too early perl version", 2);
+ ok(1, 1);
+ ok(1, 1);
}
@r = &Devel::PPPort::check_c_array();
-is($r[0], 4);
-is($r[1], "13");
+ok($r[0], 4);
+ok($r[1], "13");
ok(!Devel::PPPort::SvRXOK(""));
ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
-if (ivers($]) < ivers(5.5)) {
- skip 'no qr// objects in this perl', 2;
+if ($] < 5.005) {
+ skip 'no qr// objects in this perl', 0;
+ skip 'no qr// objects in this perl', 0;
} else {
my $qr = eval 'qr/./';
- ok(Devel::PPPort::SvRXOK($qr), "SVRXOK(qr) is true");
+ ok(Devel::PPPort::SvRXOK($qr));
ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise"));
}
-
-ok( Devel::PPPort::NATIVE_TO_LATIN1(0xB6) == 0xB6);
-ok( Devel::PPPort::NATIVE_TO_LATIN1(0x1) == 0x1);
-ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("A")) == 0x41);
-ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("0")) == 0x30);
-
-ok( Devel::PPPort::LATIN1_TO_NATIVE(0xB6) == 0xB6, "Verify LATIN1_TO_NATIVE(0xB6) is 0xB6");
-if (ord("A") == 65) {
- ok( Devel::PPPort::LATIN1_TO_NATIVE(0x41) == 0x41);
- ok( Devel::PPPort::LATIN1_TO_NATIVE(0x30) == 0x30);
-}
-else {
- ok( Devel::PPPort::LATIN1_TO_NATIVE(0x41) == 0xC1);
- ok( Devel::PPPort::LATIN1_TO_NATIVE(0x30) == 0xF0);
-}
-
-ok( Devel::PPPort::isALNUMC_L1(ord("5")));
-ok( Devel::PPPort::isALNUMC_L1(0xFC));
-ok(! Devel::PPPort::isALNUMC_L1(0xB6));
-
-ok( Devel::PPPort::isOCTAL(ord("7")), "Verify '7' is OCTAL");
-ok(! Devel::PPPort::isOCTAL(ord("8")), "Verify '8' isn't OCTAL");
-
-ok( Devel::PPPort::isOCTAL_A(ord("0")), "Verify '0' is OCTAL_A");
-ok(! Devel::PPPort::isOCTAL_A(ord("9")), "Verify '9' isn't OCTAL_A");
-
-ok( Devel::PPPort::isOCTAL_L1(ord("2")), "Verify '2' is OCTAL_L1");
-ok(! Devel::PPPort::isOCTAL_L1(ord("8")), "Verify '8' isn't OCTAL_L1");
-
-my $way_too_early_msg = 'UTF-8 not implemented on this perl';
-
-# For the other properties, we test every code point from 0.255, and a
-# smattering of higher ones. First populate a hash with keys like '65:ALPHA'
-# to indicate that the code point there is alphabetic
-my $i;
-my %types;
-for $i (0x41..0x5A, 0x61..0x7A, 0xAA, 0xB5, 0xBA, 0xC0..0xD6, 0xD8..0xF6,
- 0xF8..0x101)
-{
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:ALPHA"} = 1;
- $types{"$native:ALPHANUMERIC"} = 1;
- $types{"$native:IDFIRST"} = 1;
- $types{"$native:IDCONT"} = 1;
- $types{"$native:PRINT"} = 1;
- $types{"$native:WORDCHAR"} = 1;
-}
-for $i (0x30..0x39, 0x660, 0xFF19) {
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:ALPHANUMERIC"} = 1;
- $types{"$native:DIGIT"} = 1;
- $types{"$native:IDCONT"} = 1;
- $types{"$native:WORDCHAR"} = 1;
- $types{"$native:GRAPH"} = 1;
- $types{"$native:PRINT"} = 1;
- $types{"$native:XDIGIT"} = 1 if $i < 255 || ($i >= 0xFF10 && $i <= 0xFF19);
-}
-
-for $i (0..0x7F) {
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:ASCII"} = 1;
-}
-for $i (0..0x1f, 0x7F..0x9F) {
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:CNTRL"} = 1;
-}
-for $i (0x21..0x7E, 0xA1..0x101, 0x660) {
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:GRAPH"} = 1;
- $types{"$native:PRINT"} = 1;
-}
-for $i (0x09, 0x20, 0xA0) {
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:BLANK"} = 1;
- $types{"$native:SPACE"} = 1;
- $types{"$native:PSXSPC"} = 1;
- $types{"$native:PRINT"} = 1 if $i > 0x09;
-}
-for $i (0x09..0x0D, 0x85, 0x2029) {
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:SPACE"} = 1;
- $types{"$native:PSXSPC"} = 1;
-}
-for $i (0x41..0x5A, 0xC0..0xD6, 0xD8..0xDE, 0x100) {
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:UPPER"} = 1;
- $types{"$native:XDIGIT"} = 1 if $i < 0x47;
-}
-for $i (0x61..0x7A, 0xAA, 0xB5, 0xBA, 0xDF..0xF6, 0xF8..0xFF, 0x101) {
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:LOWER"} = 1;
- $types{"$native:XDIGIT"} = 1 if $i < 0x67;
-}
-for $i (0x21..0x2F, 0x3A..0x40, 0x5B..0x60, 0x7B..0x7E, 0xB6, 0xA1, 0xA7, 0xAB,
- 0xB7, 0xBB, 0xBF, 0x5BE)
-{
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- $types{"$native:PUNCT"} = 1;
- $types{"$native:GRAPH"} = 1;
- $types{"$native:PRINT"} = 1;
-}
-
-$i = ord('_');
-$types{"$i:WORDCHAR"} = 1;
-$types{"$i:IDFIRST"} = 1;
-$types{"$i:IDCONT"} = 1;
-
-# Now find all the unique code points included above.
-my %code_points_to_test;
-my $key;
-for $key (keys %types) {
- $key =~ s/:.*//;
- $code_points_to_test{$key} = 1;
-}
-
-# And test each one
-for $i (sort { $a <=> $b } keys %code_points_to_test) {
- my $native = Devel::PPPort::LATIN1_TO_NATIVE($i);
- my $hex = sprintf("0x%02X", $native);
-
- # And for each code point test each of the classes
- my $class;
- for $class (qw(ALPHA ALPHANUMERIC ASCII BLANK CNTRL DIGIT GRAPH IDCONT
- IDFIRST LOWER PRINT PSXSPC PUNCT SPACE UPPER WORDCHAR
- XDIGIT))
- {
- if ($i < 256) { # For the ones that can fit in a byte, test each of
- # three macros.
- my $suffix;
- for $suffix ("", "_A", "_L1", "_uvchr") {
- my $should_be = ($i > 0x7F && $suffix !~ /_(uvchr|L1)/)
- ? 0 # Fail on non-ASCII unless unicode
- : ($types{"$native:$class"} || 0);
- if (ivers($]) < ivers(5.6) && $suffix eq '_uvchr') {
- skip("No UTF-8 on this perl", 1);
- next;
- }
-
- my $eval_string = "Devel::PPPort::is${class}$suffix($hex)";
- local $SIG{__WARN__} = sub {};
- my $is = eval $eval_string || 0;
- die "eval 'For $i: $eval_string' gave $@" if $@;
- is($is, $should_be, "'$eval_string'");
- }
- }
-
- # For all code points, test the '_utf8' macros
- my $sub_fcn;
- for $sub_fcn ("", "_LC") {
- my $skip = "";
- if (ivers($]) < ivers(5.6)) {
- $skip = $way_too_early_msg;
- }
- elsif (ivers($]) < ivers(5.7) && $native > 255) {
- $skip = "Perls earlier than 5.7 give wrong answers for above Latin1 code points";
- }
- elsif (ivers($]) <= ivers(5.11.3) && $native == 0x2029 && ($class eq 'PRINT' || $class eq 'GRAPH')) {
- $skip = "Perls earlier than 5.11.3 considered high space characters as isPRINT and isGRAPH";
- }
- elsif ($sub_fcn eq '_LC' && $i < 256) {
- $skip = "Testing of code points whose results depend on locale is skipped ";
- }
- my $fcn = "Devel::PPPort::is${class}${sub_fcn}_utf8_safe";
- my $utf8;
-
- if ($skip) {
- skip $skip, 1;
- }
- else {
- $utf8 = quotemeta Devel::PPPort::uvchr_to_utf8($native);
- my $should_be = $types{"$native:$class"} || 0;
- my $eval_string = "$fcn(\"$utf8\", 0)";
- local $SIG{__WARN__} = sub {};
- my $is = eval $eval_string || 0;
- die "eval 'For $i, $eval_string' gave $@" if $@;
- is($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
- }
-
- # And for the high code points, test that a too short malformation (the
- # -1) causes it to fail
- if ($i > 255) {
- if ($skip) {
- skip $skip, 1;
- }
- elsif (ivers($]) >= ivers(5.25.9)) {
- skip("Prints an annoying error message that khw doesn't know how to easily suppress", 1);
- }
- else {
- my $eval_string = "$fcn(\"$utf8\", -1)";
- local $SIG{__WARN__} = sub {};
- my $is = eval "$eval_string" || 0;
- die "eval '$eval_string' gave $@" if $@;
- is($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
- }
- }
- }
- }
-}
-
-my %case_changing = ( 'LOWER' => [ [ ord('A'), ord('a') ],
- [ Devel::PPPort::LATIN1_TO_NATIVE(0xC0),
- Devel::PPPort::LATIN1_TO_NATIVE(0xE0) ],
- [ 0x100, 0x101 ],
- ],
- 'FOLD' => [ [ ord('C'), ord('c') ],
- [ Devel::PPPort::LATIN1_TO_NATIVE(0xC0),
- Devel::PPPort::LATIN1_TO_NATIVE(0xE0) ],
- [ 0x104, 0x105 ],
- [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF),
- 'ss' ],
- ],
- 'UPPER' => [ [ ord('a'), ord('A'), ],
- [ Devel::PPPort::LATIN1_TO_NATIVE(0xE0),
- Devel::PPPort::LATIN1_TO_NATIVE(0xC0) ],
- [ 0x101, 0x100 ],
- [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF),
- 'SS' ],
- ],
- 'TITLE' => [ [ ord('c'), ord('C'), ],
- [ Devel::PPPort::LATIN1_TO_NATIVE(0xE2),
- Devel::PPPort::LATIN1_TO_NATIVE(0xC2) ],
- [ 0x103, 0x102 ],
- [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF),
- 'Ss' ],
- ],
- );
-
-my $name;
-for $name (keys %case_changing) {
- my @code_points_to_test = @{$case_changing{$name}};
- my $unchanged;
- for $unchanged (@code_points_to_test) {
- my @pair = @$unchanged;
- my $original = $pair[0];
- my $changed = $pair[1];
- my $utf8_changed = $changed;
- my $is_cp = $utf8_changed =~ /^\d+$/;
- my $should_be_bytes;
- if (ivers($]) >= ivers(5.6)) {
- if ($is_cp) {
- $utf8_changed = Devel::PPPort::uvchr_to_utf8($changed);
- $should_be_bytes = Devel::PPPort::UTF8_SAFE_SKIP($utf8_changed, 0);
- }
- else {
- die("Test currently doesn't work for non-ASCII multi-char case changes") if eval '$utf8_changed =~ /[[:^ascii:]]/';
- $should_be_bytes = length $utf8_changed;
- }
- }
-
- my $fcn = "to${name}_uvchr";
- my $skip = "";
-
- if (ivers($]) < ivers(5.6)) {
- $skip = $way_too_early_msg;
- }
- elsif (! $is_cp) {
- $skip = "Can't do uvchr on a multi-char string";
- }
- if ($skip) {
- skip $skip, 4;
- }
- else {
- if ($is_cp) {
- $utf8_changed = Devel::PPPort::uvchr_to_utf8($changed);
- $should_be_bytes = Devel::PPPort::UTF8_SAFE_SKIP($utf8_changed, 0);
- }
- else {
- my $non_ascii_re = (ivers($]) >= ivers(5.6)) ? '[[:^ascii:]]' : '[^\x00-\x7F]';
- die("Test currently doesn't work for non-ASCII multi-char case changes") if eval '$utf8_changed =~ /$non_ascii_re/';
- $should_be_bytes = length $utf8_changed;
- }
-
- my $ret = eval "Devel::PPPort::$fcn($original)";
- my $fail = $@; # Have to save $@, as it gets destroyed
- is ($fail, "", "$fcn($original) didn't fail");
- my $first = (ivers($]) != ivers(5.6))
- ? substr($utf8_changed, 0, 1)
- : $utf8_changed, 0, 1;
- is($ret->[0], ord $first,
- "ord of $fcn($original) is $changed");
- is($ret->[1], $utf8_changed,
- "UTF-8 of of $fcn($original) is correct");
- is($ret->[2], $should_be_bytes,
- "Length of $fcn($original) is $should_be_bytes");
- }
-
- my $truncate;
- for $truncate (0..2) {
- my $skip;
- if (ivers($]) < ivers(5.6)) {
- $skip = $way_too_early_msg;
- }
- elsif (! $is_cp && ivers($]) < ivers(5.7.3)) {
- $skip = "Multi-character case change not implemented until 5.7.3";
- }
- elsif ($truncate == 2 && ivers($]) > ivers(5.25.8)) {
- $skip = "Zero length inputs cause assertion failure; test dies in modern perls";
- }
- elsif ($truncate > 0 && length $changed > 1) {
- $skip = "Don't test shortened multi-char case changes";
- }
- elsif ($truncate > 0 && Devel::PPPort::UVCHR_IS_INVARIANT($original)) {
- $skip = "Don't try to test shortened single bytes";
- }
- if ($skip) {
- skip $skip, 4;
- }
- else {
- my $fcn = "to${name}_utf8_safe";
- my $utf8 = quotemeta Devel::PPPort::uvchr_to_utf8($original);
- my $real_truncate = ($truncate < 2)
- ? $truncate : $should_be_bytes;
- my $eval_string = "Devel::PPPort::$fcn(\"$utf8\", $real_truncate)";
- my $ret = eval "no warnings; $eval_string" || 0;
- my $fail = $@; # Have to save $@, as it gets destroyed
- if ($truncate == 0) {
- is ($fail, "", "Didn't fail on full length input");
- my $first = (ivers($]) != ivers(5.6))
- ? substr($utf8_changed, 0, 1)
- : $utf8_changed, 0, 1;
- is($ret->[0], ord $first,
- "ord of $fcn($original) is $changed");
- is($ret->[1], $utf8_changed,
- "UTF-8 of of $fcn($original) is correct");
- is($ret->[2], $should_be_bytes,
- "Length of $fcn($original) is $should_be_bytes");
- }
- else {
- is ($fail, eval 'qr/Malformed UTF-8 character/',
- "Gave appropriate error for short char: $original");
- skip("Expected failure means remaining tests for"
- . " this aren't relevant", 3);
- }
- }
- }
- }
-}
-
-is(&Devel::PPPort::av_top_index([1,2,3]), 2);
-is(&Devel::PPPort::av_tindex([1,2,3,4]), 3);