X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8154c0b1642d2b0fab033464d4ae3fbbba80affc..91497b7f1eadb85318d1721ab68c3a72fedb43c6:/dist/Devel-PPPort/parts/inc/misc diff --git a/dist/Devel-PPPort/parts/inc/misc b/dist/Devel-PPPort/parts/inc/misc index 8e695f3..ffed764 100644 --- a/dist/Devel-PPPort/parts/inc/misc +++ b/dist/Devel-PPPort/parts/inc/misc @@ -12,6 +12,7 @@ =provides __UNDEFINED__ +__REDEFINE__ END_EXTERN_C EXTERN_C INT2PTR @@ -19,6 +20,7 @@ MUTABLE_PTR NVTYPE PERLIO_FUNCS_CAST PERLIO_FUNCS_DECL +PERL_STATIC_INLINE PERL_UNUSED_ARG PERL_UNUSED_CONTEXT PERL_UNUSED_DECL @@ -33,9 +35,17 @@ STMT_START SvRX WIDEST_UTYPE XSRETURN +NOT_REACHED +ASSUME =implementation +#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L +__UNDEFINED__ PERL_STATIC_INLINE static inline +#else +__UNDEFINED__ PERL_STATIC_INLINE static +#endif + __UNDEFINED__ cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0) __UNDEFINED__ OpHAS_SIBLING(o) (cBOOL((o)->op_sibling)) __UNDEFINED__ OpSIBLING(o) (0 + (o)->op_sibling) @@ -50,15 +60,68 @@ __UNDEFINED__ __ASSERT_(statement) assert(statement), __UNDEFINED__ __ASSERT_(statement) #endif -/* These could become provided when they become part of the public API */ +__UNDEF_NOT_PROVIDED__ __has_builtin(x) 0 + +#if __has_builtin(__builtin_unreachable) +# define D_PPP_HAS_BUILTIN_UNREACHABLE +#elif (defined(__GNUC__) && ( __GNUC__ > 4 \ + || __GNUC__ == 4 && __GNUC_MINOR__ >= 5)) +# define D_PPP_HAS_BUILTIN_UNREACHABLE +#endif + +#ifndef ASSUME +# ifdef DEBUGGING +# define ASSUME(x) assert(x) +# elif defined(_MSC_VER) +# define ASSUME(x) __assume(x) +# elif defined(__ARMCC_VERSION) +# define ASSUME(x) __promise(x) +# elif defined(D_PPP_HAS_BUILTIN_UNREACHABLE) +# define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable()) +# else +# define ASSUME(x) assert(x) +# endif +#endif + +#ifndef NOT_REACHED +# ifdef D_PPP_HAS_BUILTIN_UNREACHABLE +# define NOT_REACHED \ + STMT_START { \ + ASSUME(!"UNREACHABLE"); __builtin_unreachable(); \ + } STMT_END +# elif ! defined(__GNUC__) && (defined(__sun) || defined(__hpux)) +# define NOT_REACHED +# else +# define NOT_REACHED ASSUME(!"UNREACHABLE") +# endif +#endif + +#ifndef WIDEST_UTYPE +# ifdef QUADKIND +# ifdef U64TYPE +# define WIDEST_UTYPE U64TYPE +# else +# define WIDEST_UTYPE unsigned Quad_t +# endif +# else +# define WIDEST_UTYPE U32 +# 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 @@ -165,7 +228,10 @@ __UNDEFINED__ SvRXOK(sv) (!!SvRX(sv)) #endif __UNDEFINED__ NOOP /*EMPTY*/(void)0 -__UNDEFINED__ dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL + +#if { VERSION < 5.6.1 } && { VERSION < 5.27.7 } +__REDEFINE__ dNOOP struct Perl___notused_struct +#endif #ifndef NVTYPE # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) @@ -204,17 +270,14 @@ __UNDEFINED__ PTR2IV(p) INT2PTR(IV,p) __UNDEFINED__ PTR2UV(p) INT2PTR(UV,p) __UNDEFINED__ PTR2NV(p) NUM2PTR(NV,p) -#undef START_EXTERN_C -#undef END_EXTERN_C -#undef EXTERN_C #ifdef __cplusplus -# define START_EXTERN_C extern "C" { -# define END_EXTERN_C } -# define EXTERN_C extern "C" +__REDEFINE__ START_EXTERN_C extern "C" { +__REDEFINE__ END_EXTERN_C } +__REDEFINE__ EXTERN_C extern "C" #else -# define START_EXTERN_C -# define END_EXTERN_C -# define EXTERN_C extern +__REDEFINE__ START_EXTERN_C +__REDEFINE__ END_EXTERN_C +__REDEFINE__ EXTERN_C extern #endif #if { VERSION < 5.004 } || defined(PERL_GCC_PEDANTIC) @@ -223,25 +286,20 @@ __UNDEF_NOT_PROVIDED__ PERL_GCC_BRACE_GROUPS_FORBIDDEN # endif #endif -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) +#if ! defined(__GNUC__) || defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) || defined(__cplusplus) +# undef PERL_USE_GCC_BRACE_GROUPS +#else # ifndef PERL_USE_GCC_BRACE_GROUPS # define PERL_USE_GCC_BRACE_GROUPS # endif #endif -#undef STMT_START -#undef STMT_END -#ifdef PERL_USE_GCC_BRACE_GROUPS -# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ -# define STMT_END ) +#if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) +__REDEFINE__ STMT_START if (1) +__REDEFINE__ STMT_END else (void)0 #else -# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) -# define STMT_START if (1) -# define STMT_END else (void)0 -# else -# define STMT_START do -# define STMT_END while (0) -# endif +__REDEFINE__ STMT_START do +__REDEFINE__ STMT_END while (0) #endif __UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) @@ -256,6 +314,7 @@ __UNDEFINED__ AvFILLp AvFILL __UNDEFINED__ av_tindex AvFILL __UNDEFINED__ av_top_index AvFILL +__UNDEFINED__ av_count(av) (AvFILL(av)+1) __UNDEFINED__ ERRSV get_sv("@",FALSE) @@ -284,14 +343,13 @@ __UNDEFINED__ dITEMS I32 items = SP - MARK __UNDEFINED__ dXSTARG SV * targ = sv_newmortal() __UNDEFINED__ dAXMARK I32 ax = POPMARK; \ - register SV ** const mark = PL_stack_base + ax++ + SV ** const mark = PL_stack_base + ax++ __UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1) #if { VERSION < 5.005 } -# undef XSRETURN -# define XSRETURN(off) \ +__REDEFINE__ XSRETURN(off) \ STMT_START { \ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ return; \ @@ -342,18 +400,6 @@ typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); #endif -#ifndef WIDEST_UTYPE -# ifdef QUADKIND -# ifdef U64TYPE -# define WIDEST_UTYPE U64TYPE -# else -# define WIDEST_UTYPE Quad_t -# endif -# else -# define WIDEST_UTYPE U32 -# 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) @@ -391,8 +437,8 @@ __UNDEFINED__ UNI_TO_NATIVE(c) (c) #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 */ + * 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 @@ -556,10 +602,10 @@ __UNDEFINED__ isUPPER(c) ( (c) >= 'A' && (c) <= 'Z' __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') +__UNDEFINED__ isCNTRL_L1(c) ( (WIDEST_UTYPE) (c) < ' ' \ + || inRANGE((c), 0x7F, 0x9F)) +__UNDEFINED__ isLOWER(c) inRANGE((c), 'a', 'z') +__UNDEFINED__ isUPPER(c) inRANGE((c), 'A', 'Z') #endif /* Below are definitions common to EBCDIC and ASCII */ @@ -575,10 +621,10 @@ __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) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || ( FITS_IN_8_BITS(c) \ && NATIVE_TO_LATIN1((U8) c) == 0xA0)) __UNDEFINED__ isBLANK_LC(c) isBLANK(c) -__UNDEFINED__ isDIGIT(c) ((c) <= '9' && (c) >= '0') +__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) \ @@ -591,7 +637,7 @@ __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) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || ( FITS_IN_8_BITS(c) \ && ( ( NATIVE_TO_LATIN1((U8) c) >= 0xDF \ && NATIVE_TO_LATIN1((U8) c) != 0xF7) \ || NATIVE_TO_LATIN1((U8) c) == 0xAA \ @@ -600,7 +646,7 @@ __UNDEFINED__ isLOWER_L1(c) ( isLOWER(c) \ __UNDEFINED__ isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0') __UNDEFINED__ isOCTAL_L1(c) isOCTAL(c) __UNDEFINED__ isPRINT(c) (isGRAPH(c) || (c) == ' ') -__UNDEFINED__ isPRINT_L1(c) ((WIDEST_UTYPE) (c) < 256 && ! isCNTRL_L1(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) == '"' \ @@ -615,7 +661,7 @@ __UNDEFINED__ isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \ || (c) == '`' || (c) == '{' || (c) == '|' \ || (c) == '}' || (c) == '~') __UNDEFINED__ isPUNCT_L1(c) ( isPUNCT(c) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || ( FITS_IN_8_BITS(c) \ && ( NATIVE_TO_LATIN1((U8) c) == 0xA1 \ || NATIVE_TO_LATIN1((U8) c) == 0xA7 \ || NATIVE_TO_LATIN1((U8) c) == 0xAB \ @@ -626,11 +672,11 @@ __UNDEFINED__ isPUNCT_L1(c) ( isPUNCT(c) \ __UNDEFINED__ isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \ || (c) == '\v' || (c) == '\f') __UNDEFINED__ isSPACE_L1(c) ( isSPACE(c) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || (FITS_IN_8_BITS(c) \ && ( NATIVE_TO_LATIN1((U8) c) == 0x85 \ || NATIVE_TO_LATIN1((U8) c) == 0xA0))) __UNDEFINED__ isUPPER_L1(c) ( isUPPER(c) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || (FITS_IN_8_BITS(c) \ && ( NATIVE_TO_LATIN1((U8) c) >= 0xC0 \ && NATIVE_TO_LATIN1((U8) c) <= 0xDE \ && NATIVE_TO_LATIN1((U8) c) != 0xD7))) @@ -638,8 +684,8 @@ __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')) + || inRANGE((c), 'a', 'f') \ + || inRANGE((c), 'A', 'F')) __UNDEFINED__ isXDIGIT_L1(c) isXDIGIT(c) __UNDEFINED__ isXDIGIT_LC(c) isxdigit(c) @@ -665,20 +711,27 @@ __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) ((WIDEST_UTYPE) (c) < 256 \ - ? isASCII_L1(c) : 0) +__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) ((WIDEST_UTYPE) (c) < 256 \ - ? isALPHA_L1(c) : is_uni_alpha((UV) (c))) -__UNDEFINED__ isALPHANUMERIC_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isALPHANUMERIC_L1(c) : (is_uni_alpha((UV) (c)) || is_uni_digit((UV) (c)))) +__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) ((WIDEST_UTYPE) (c) < 256 \ - ? isBLANK_L1(c) : is_uni_blank((UV) (c))) +__UNDEFINED__ isBLANK_uvchr(c) D_PPP_is_ctype(BLANK, blank, c) # else -__UNDEFINED__ isBLANK_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ +__UNDEFINED__ isBLANK_uvchr(c) (FITS_IN_8_BITS(c) \ ? isBLANK_L1(c) \ : ( (UV) (c) == 0x1680 /* Unicode 3.0 */ \ || inRANGE((UV) (c), 0x2000, 0x200A) \ @@ -686,30 +739,20 @@ __UNDEFINED__ isBLANK_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ || (UV) (c) == 0x205F /* Unicode 3.2 */\ || (UV) (c) == 0x3000)) # endif -__UNDEFINED__ isCNTRL_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isCNTRL_L1(c) : is_uni_cntrl((UV) (c))) -__UNDEFINED__ isDIGIT_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isDIGIT_L1(c) : is_uni_digit((UV) (c))) -__UNDEFINED__ isGRAPH_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isGRAPH_L1(c) : is_uni_graph((UV) (c))) -__UNDEFINED__ isIDCONT_uvchr(c) isWORDCHAR_uvchr(c) -__UNDEFINED__ isIDFIRST_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isIDFIRST_L1(c) : is_uni_idfirst((UV) (c))) -__UNDEFINED__ isLOWER_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isLOWER_L1(c) : is_uni_lower((UV) (c))) -__UNDEFINED__ isPRINT_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isPRINT_L1(c) : is_uni_print((UV) (c))) +__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) ((WIDEST_UTYPE) (c) < 256 \ - ? isPUNCT_L1(c) : is_uni_punct((UV) (c))) -__UNDEFINED__ isSPACE_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isSPACE_L1(c) : is_uni_space((UV) (c))) -__UNDEFINED__ isUPPER_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isUPPER_L1(c) : is_uni_upper((UV) (c))) -__UNDEFINED__ isXDIGIT_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isXDIGIT_L1(c) : is_uni_xdigit((UV) (c))) -__UNDEFINED__ isWORDCHAR_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isWORDCHAR_L1(c) : is_uni_alnum((UV) (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 @@ -796,8 +839,8 @@ __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) +/* Use the modern definition */ +__REDEFINE__ 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) @@ -869,8 +912,8 @@ __UNDEFINED__ isIDFIRST_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, I __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) +/* Use the modern definition */ +__REDEFINE__ 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) @@ -1065,13 +1108,18 @@ __UNDEFINED__ LIKELY(x) (x) __UNDEFINED__ UNLIKELY(x) (x) #ifndef MUTABLE_PTR -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#if defined(PERL_USE_GCC_BRACE_GROUPS) # define MUTABLE_PTR(p) ({ void *_p = (p); _p; }) #else # define MUTABLE_PTR(p) ((void *) (p)) #endif #endif +__UNDEFINED__ MUTABLE_AV(p) ((AV *)MUTABLE_PTR(p)) +__UNDEFINED__ MUTABLE_CV(p) ((CV *)MUTABLE_PTR(p)) +__UNDEFINED__ MUTABLE_GV(p) ((GV *)MUTABLE_PTR(p)) +__UNDEFINED__ MUTABLE_HV(p) ((HV *)MUTABLE_PTR(p)) +__UNDEFINED__ MUTABLE_IO(p) ((IO *)MUTABLE_PTR(p)) __UNDEFINED__ MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) =xsmisc @@ -1121,10 +1169,10 @@ newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file); int OpSIBLING_tests() PREINIT: - OP *x; - OP *kid; - OP *middlekid; - OP *lastkid; + OP *x = NULL; + OP *kid = NULL; + OP *middlekid = NULL; + OP *lastkid = NULL; int count = 0; int failures = 0; int i; @@ -1380,8 +1428,8 @@ check_HeUTF8(utf8_key) hash = newHV(); key = SvPV(utf8_key, klen); - if (SvUTF8(utf8_key)) klen *= -1; - hv_store(hash, key, klen, newSVpvs("string"), 0); + hv_store(hash, key, SvUTF8(utf8_key) ? -klen : klen, + newSVpvs("string"), 0); hv_iterinit(hash); ent = hv_iternext(hash); assert(ent); @@ -1868,6 +1916,7 @@ 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 @@ -2169,6 +2218,7 @@ 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 @@ -2522,34 +2572,42 @@ av_top_index(av) OUTPUT: RETVAL -=tests plan => 26826 +STRLEN +av_count(av) + SV *av + CODE: + RETVAL = av_count((AV*)SvRV(av)); + OUTPUT: + RETVAL + +=tests plan => 26827 use vars qw($my_sv @my_av %my_hv); -ok(&Devel::PPPort::boolSV(1)); -ok(!&Devel::PPPort::boolSV(0)); +ok(&Devel::PPPort::boolSV(1), "Verify boolSV(1) is true"); +ok(!&Devel::PPPort::boolSV(0), "Verify boolSV(0) is false"); $_ = "Fred"; -is(&Devel::PPPort::DEFSV(), "Fred"); -is(&Devel::PPPort::UNDERBAR(), "Fred"); +is(&Devel::PPPort::DEFSV(), "Fred", '$_ is FRED; Verify DEFSV is FRED'); +is(&Devel::PPPort::UNDERBAR(), "Fred", 'And verify UNDERBAR is FRED'); if (ivers($]) >= ivers(5.9.2) && ivers($]) < ivers(5.23)) { 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"); - is(&Devel::PPPort::UNDERBAR(), "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'); }; + die __FILE__ . __LINE__ . ": $@" if $@; } else { - ok(1); - ok(1); + skip("perl version outside testing range of lexical_topic", 2); } my @r = &Devel::PPPort::DEFSV_modify(); -ok(@r == 3); +ok(@r == 3, "Verify got 3 elements"); is($r[0], 'Fred'); is($r[1], 'DEFSV'); is($r[2], 'Fred'); @@ -2557,9 +2615,9 @@ is($r[2], 'Fred'); is(&Devel::PPPort::DEFSV(), "Fred"); eval { 1 }; -ok(!&Devel::PPPort::ERRSV()); +ok(!&Devel::PPPort::ERRSV(), "Verify ERRSV on true is false"); eval { cannot_call_this_one() }; -ok(&Devel::PPPort::ERRSV()); +ok(&Devel::PPPort::ERRSV(), "Verify ERRSV on false is true"); ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0)); ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0)); @@ -2593,8 +2651,8 @@ is(Devel::PPPort::prepush(), 42); is(join(':', Devel::PPPort::xsreturn(0)), 'test1'); is(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); -is(Devel::PPPort::PERL_ABS(42), 42); -is(Devel::PPPort::PERL_ABS(-13), 13); +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"); is(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42'); is(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc'); @@ -2625,7 +2683,7 @@ if (ivers($]) < ivers(5.5)) { skip 'no qr// objects in this perl', 2; } else { my $qr = eval 'qr/./'; - ok(Devel::PPPort::SvRXOK($qr)); + ok(Devel::PPPort::SvRXOK($qr), "SVRXOK(qr) is true"); ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise")); } @@ -2634,7 +2692,7 @@ 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); +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); @@ -2648,14 +2706,14 @@ 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"))); -ok(! Devel::PPPort::isOCTAL(ord("8"))); +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"))); -ok(! Devel::PPPort::isOCTAL_A(ord("9"))); +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"))); -ok(! Devel::PPPort::isOCTAL_L1(ord("8"))); +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'; @@ -2755,7 +2813,7 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { XDIGIT)) { if ($i < 256) { # For the ones that can fit in a byte, test each of - #three macros. + # three macros. my $suffix; for $suffix ("", "_A", "_L1", "_uvchr") { my $should_be = ($i > 0x7F && $suffix !~ /_(uvchr|L1)/) @@ -2767,6 +2825,7 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { } 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'"); @@ -2796,9 +2855,10 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { skip $skip, 1; } else { - $utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($i); + $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)); @@ -2815,7 +2875,8 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { } else { my $eval_string = "$fcn(\"$utf8\", -1)"; - my $is = eval "no warnings; $eval_string" || 0; + 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)); } @@ -2825,23 +2886,30 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { } my %case_changing = ( 'LOWER' => [ [ ord('A'), ord('a') ], - [ 0xC0, 0xE0 ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xC0), + Devel::PPPort::LATIN1_TO_NATIVE(0xE0) ], [ 0x100, 0x101 ], ], 'FOLD' => [ [ ord('C'), ord('c') ], - [ 0xC0, 0xE0 ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xC0), + Devel::PPPort::LATIN1_TO_NATIVE(0xE0) ], [ 0x104, 0x105 ], - [ 0xDF, 'ss' ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF), + 'ss' ], ], - 'UPPER' => [ [ ord('a'),ord('A'), ], - [ 0xE0, 0xC0 ], + 'UPPER' => [ [ ord('a'), ord('A'), ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xE0), + Devel::PPPort::LATIN1_TO_NATIVE(0xC0) ], [ 0x101, 0x100 ], - [ 0xDF, 'SS' ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF), + 'SS' ], ], - 'TITLE' => [ [ ord('c'),ord('C'), ], - [ 0xE2, 0xC2 ], + 'TITLE' => [ [ ord('c'), ord('C'), ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xE2), + Devel::PPPort::LATIN1_TO_NATIVE(0xC2) ], [ 0x103, 0x102 ], - [ 0xDF, 'Ss' ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF), + 'Ss' ], ], ); @@ -2858,11 +2926,11 @@ for $name (keys %case_changing) { my $should_be_bytes; if (ivers($]) >= ivers(5.6)) { if ($is_cp) { - $utf8_changed = Devel::PPPort::uvoffuni_to_utf8($changed); + $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 $utf8_changed =~ /[[:^ascii:]]/; + die("Test currently doesn't work for non-ASCII multi-char case changes") if eval '$utf8_changed =~ /[[:^ascii:]]/'; $should_be_bytes = length $utf8_changed; } } @@ -2881,11 +2949,12 @@ for $name (keys %case_changing) { } else { if ($is_cp) { - $utf8_changed = Devel::PPPort::uvoffuni_to_utf8($changed); + $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 $utf8_changed =~ /[[:^ascii:]]/; + 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; } @@ -2926,7 +2995,7 @@ for $name (keys %case_changing) { } else { my $fcn = "to${name}_utf8_safe"; - my $utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($original); + 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)"; @@ -2957,3 +3026,4 @@ for $name (keys %case_changing) { is(&Devel::PPPort::av_top_index([1,2,3]), 2); is(&Devel::PPPort::av_tindex([1,2,3,4]), 3); +is(&Devel::PPPort::av_count([1,2,3,4]), 4);