#define PERL_IN_XS_APITEST
+
+/* We want to be able to test things that aren't API yet. */
+#define PERL_EXT
+
+/* Do *not* define PERL_NO_GET_CONTEXT. This is the one place where we get
+ to test implicit Perl_get_context(). */
+
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+
+typedef FILE NativeFile;
+
#include "fakesdio.h" /* Causes us to use PerlIO below */
typedef SV *SVREF;
typedef PTR_TBL_t *XS__APItest__PtrTable;
+typedef PerlIO * InputStream;
+typedef PerlIO * OutputStream;
#define croak_fail() croak("fail at " __FILE__ " line %d", __LINE__)
-#define croak_fail_ne(h, w) croak("fail %p!=%p at " __FILE__ " line %d", (h), (w), __LINE__)
+#define croak_fail_nep(h, w) croak("fail %p!=%p at " __FILE__ " line %d", (h), (w), __LINE__)
+#define croak_fail_nei(h, w) croak("fail %d!=%d at " __FILE__ " line %d", (int)(h), (int)(w), __LINE__)
+
+#ifdef EBCDIC
+
+void
+cat_utf8a2n(SV* sv, const char * const ascii_utf8, STRLEN len)
+{
+ /* Converts variant UTF-8 text pointed to by 'ascii_utf8' of length 'len',
+ * to UTF-EBCDIC, appending that text to the text already in 'sv'.
+ * Currently doesn't work on invariants, as that is unneeded here, and we
+ * could get double translations if we did.
+ *
+ * It has the algorithm for strict UTF-8 hard-coded in to find the code
+ * point it represents, then calls uvchr_to_utf8() to convert to
+ * UTF-EBCDIC).
+ *
+ * Note that this uses code points, not characters. Thus if the input is
+ * the UTF-8 for the code point 0xFF, the output will be the UTF-EBCDIC for
+ * 0xFF, even though that code point represents different characters on
+ * ASCII vs EBCDIC platforms. */
+
+ dTHX;
+ char * p = (char *) ascii_utf8;
+ const char * const e = p + len;
+
+ while (p < e) {
+ UV code_point;
+ U8 native_utf8[UTF8_MAXBYTES + 1];
+ U8 * char_end;
+ U8 start = (U8) *p;
+
+ /* Start bytes are the same in both UTF-8 and I8, therefore we can
+ * treat this ASCII UTF-8 byte as an I8 byte. But PL_utf8skip[] is
+ * indexed by NATIVE_UTF8 bytes, so transform to that */
+ STRLEN char_bytes_len = PL_utf8skip[I8_TO_NATIVE_UTF8(start)];
+
+ if (start < 0xc2) {
+ croak("fail: Expecting start byte, instead got 0x%X at %s line %d",
+ (U8) *p, __FILE__, __LINE__);
+ }
+ code_point = (start & (((char_bytes_len) >= 7)
+ ? 0x00
+ : (0x1F >> ((char_bytes_len)-2))));
+ p++;
+ while (p < e && ((( (U8) *p) & 0xC0) == 0x80)) {
+
+ code_point = (code_point << 6) | (( (U8) *p) & 0x3F);
+ p++;
+ }
+
+ char_end = uvchr_to_utf8(native_utf8, code_point);
+ sv_catpvn(sv, (char *) native_utf8, char_end - native_utf8);
+ }
+}
+
+#endif
/* for my_cxt tests */
START_MY_CXT
+int
+S_myset_set(pTHX_ SV* sv, MAGIC* mg)
+{
+ SV *isv = (SV*)mg->mg_ptr;
+
+ PERL_UNUSED_ARG(sv);
+ SvIVX(isv)++;
+ return 0;
+}
+
MGVTBL vtbl_foo, vtbl_bar;
+MGVTBL vtbl_myset = { 0, S_myset_set, 0, 0, 0, 0, 0, 0 };
+
/* indirect functions to test the [pa]MY_CXT macros */
#else
/* Storing then deleting something should ensure that a hash entry is
available. */
- (void) hv_store(test_hash, "", 0, &PL_sv_yes, 0);
- (void) hv_delete(test_hash, "", 0, 0);
+ (void) hv_stores(test_hash, "", &PL_sv_yes);
+ (void) hv_deletes(test_hash, "", 0);
/* We need to "inline" new_he here as it's static, and the functions we
test expect to be able to call del_HE on the HE */
i = 0;
do {
- mPUSHu(results[i]);
+ mXPUSHu(results[i]);
} while (++i < (int)(sizeof(results)/sizeof(results[0])));
/* Goodbye to our extra reference. */
SvREFCNT_dec(test_scalar);
}
+/* Not that it matters much, but it's handy for the flipped character to just
+ * be the opposite case (at least for ASCII-range and most Latin1 as well). */
+#define FLIP_BIT ('A' ^ 'a')
static I32
bitflip_key(pTHX_ IV action, SV *field) {
const char *p = SvPV(keysv, len);
if (len) {
- SV *newkey = newSV(len);
- char *new_p = SvPVX(newkey);
+ /* Allow for the flipped val to be longer than the original. This
+ * is just for testing, so can afford to have some slop */
+ const STRLEN newlen = len * 2;
+
+ SV *newkey = newSV(newlen);
+ const char * const new_p_orig = SvPVX(newkey);
+ char *new_p = (char *) new_p_orig;
if (SvUTF8(keysv)) {
const char *const end = p + len;
while (p < end) {
- STRLEN len;
- UV chr = utf8_to_uvchr_buf((U8 *)p, (U8 *) end, &len);
- new_p = (char *)uvchr_to_utf8((U8 *)new_p, chr ^ 32);
- p += len;
+ STRLEN curlen;
+ UV chr = utf8_to_uvchr_buf((U8 *)p, (U8 *) end, &curlen);
+
+ /* Make sure don't exceed bounds */
+ assert(new_p - new_p_orig + curlen < newlen);
+
+ new_p = (char *)uvchr_to_utf8((U8 *)new_p, chr ^ FLIP_BIT);
+ p += curlen;
}
SvUTF8_on(newkey);
} else {
while (len--)
- *new_p++ = *p++ ^ 32;
+ *new_p++ = *p++ ^ FLIP_BIT;
}
*new_p = '\0';
- SvCUR_set(newkey, SvCUR(keysv));
+ SvCUR_set(newkey, new_p - new_p_orig);
SvPOK_on(newkey);
mg->mg_obj = newkey;
return 0;
}
-STATIC MGVTBL rmagical_b = { 0 };
+/* We could do "= { 0 };" but some versions of gcc do warn
+ * (with -Wextra) about missing initializer, this is probably gcc
+ * being a bit too paranoid. But since this is file-static, we can
+ * just have it without initializer, since it should get
+ * zero-initialized. */
+STATIC MGVTBL rmagical_b;
STATIC void
blockhook_csc_start(pTHX_ int full)
OP *aop = cUNOPx(entersubop)->op_first;
PERL_UNUSED_ARG(namegv);
PERL_UNUSED_ARG(ckobj);
- if (!OP_HAS_SIBLING(aop))
+ if (!OpHAS_SIBLING(aop))
aop = cUNOPx(aop)->op_first;
- for (aop = OP_SIBLING(aop); OP_HAS_SIBLING(aop); aop = OP_SIBLING(aop)) {
+ for (aop = OpSIBLING(aop); OpHAS_SIBLING(aop); aop = OpSIBLING(aop)) {
op_contextualize(aop, G_SCALAR);
}
return entersubop;
OP *pushop = cUNOPx(entersubop)->op_first;
PERL_UNUSED_ARG(namegv);
PERL_UNUSED_ARG(ckobj);
- if (!OP_HAS_SIBLING(pushop)) {
+ if (!OpHAS_SIBLING(pushop)) {
parent = pushop;
pushop = cUNOPx(pushop)->op_first;
}
while (1) {
- OP *aop = OP_SIBLING(pushop);
- if (!OP_HAS_SIBLING(aop))
+ OP *aop = OpSIBLING(pushop);
+ if (!OpHAS_SIBLING(aop))
break;
/* cut out first arg */
op_sibling_splice(parent, pushop, 1, NULL);
if (o->op_flags & OPf_KIDS) {
OP *k;
sv_catpvs(res, "[");
- for (k = cUNOPx(o)->op_first; k; k = OP_SIBLING(k))
+ for (k = cUNOPx(o)->op_first; k; k = OpSIBLING(k))
test_op_list_describe_part(res, k);
sv_catpvs(res, "]");
} else {
ck_entersub_args_proto(entersubop, namegv, ckobj);
parent = entersubop;
pushop = cUNOPx(entersubop)->op_first;
- if(!OP_HAS_SIBLING(pushop)) {
+ if(!OpHAS_SIBLING(pushop)) {
parent = pushop;
pushop = cUNOPx(pushop)->op_first;
}
/* extract out first arg, then delete the rest of the tree */
- argop = OP_SIBLING(pushop);
+ argop = OpSIBLING(pushop);
op_sibling_splice(parent, pushop, 1, NULL);
op_free(entersubop);
ck_entersub_args_proto(entersubop, namegv, ckobj);
parent = entersubop;
pushop = cUNOPx(entersubop)->op_first;
- if(!OP_HAS_SIBLING(pushop)) {
+ if(!OpHAS_SIBLING(pushop)) {
parent = pushop;
pushop = cUNOPx(pushop)->op_first;
}
- argop = OP_SIBLING(pushop);
+ argop = OpSIBLING(pushop);
op_sibling_splice(parent, pushop, 1, NULL);
op_free(entersubop);
return newUNOP(OP_POSTINC, 0,
SV *a0, *a1;
ck_entersub_args_proto(entersubop, namegv, ckobj);
pushop = cUNOPx(entersubop)->op_first;
- if(!OP_HAS_SIBLING(pushop))
+ if(!OpHAS_SIBLING(pushop))
pushop = cUNOPx(pushop)->op_first;
- argop = OP_SIBLING(pushop);
- if(argop->op_type != OP_CONST || OP_SIBLING(argop)->op_type != OP_CONST)
+ argop = OpSIBLING(pushop);
+ if(argop->op_type != OP_CONST || OpSIBLING(argop)->op_type != OP_CONST)
croak("bad argument expression type for pad_scalar()");
a0 = cSVOPx_sv(argop);
- a1 = cSVOPx_sv(OP_SIBLING(argop));
+ a1 = cSVOPx_sv(OpSIBLING(argop));
switch(SvIV(a0)) {
case 1: {
SV *namesv = sv_2mortal(newSVpvs("$"));
static SV *hintkey_arrayexprflags_sv;
static SV *hintkey_DEFSV_sv;
static SV *hintkey_with_vars_sv;
+static SV *hintkey_join_with_space_sv;
static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
/* low-level parser helpers */
return newDEFSVOP();
}
-static void sv_cat_c(pTHX_ SV *sv, U32 c) {
+#define sv_cat_c(a,b) THX_sv_cat_c(aTHX_ a, b)
+static void THX_sv_cat_c(pTHX_ SV *sv, U32 c) {
char ds[UTF8_MAXBYTES + 1], *d;
d = (char *)uvchr_to_utf8((U8 *)ds, c);
if (d - ds > 1) {
return block_end(save_ix, op_append_list(OP_LINESEQ, vardeclseq, body));
}
+#define parse_join_with_space() THX_parse_join_with_space(aTHX)
+static OP *THX_parse_join_with_space(pTHX)
+{
+ OP *delim, *args;
+
+ args = parse_listexpr(0);
+ delim = newSVOP(OP_CONST, 0, newSVpvs(" "));
+ return op_convert_list(OP_JOIN, 0, op_prepend_elem(OP_LIST, delim, args));
+}
+
/* plugin glue */
#define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv)
static int my_keyword_plugin(pTHX_
char *keyword_ptr, STRLEN keyword_len, OP **op_ptr)
{
- if(keyword_len == 3 && strnEQ(keyword_ptr, "rpn", 3) &&
+ if (memEQs(keyword_ptr, keyword_len, "rpn") &&
keyword_active(hintkey_rpn_sv)) {
*op_ptr = parse_keyword_rpn();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 7 && strnEQ(keyword_ptr, "calcrpn", 7) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "calcrpn") &&
keyword_active(hintkey_calcrpn_sv)) {
*op_ptr = parse_keyword_calcrpn();
return KEYWORD_PLUGIN_STMT;
- } else if(keyword_len == 9 && strnEQ(keyword_ptr, "stufftest", 9) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "stufftest") &&
keyword_active(hintkey_stufftest_sv)) {
*op_ptr = parse_keyword_stufftest();
return KEYWORD_PLUGIN_STMT;
- } else if(keyword_len == 12 &&
- strnEQ(keyword_ptr, "swaptwostmts", 12) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "swaptwostmts") &&
keyword_active(hintkey_swaptwostmts_sv)) {
*op_ptr = parse_keyword_swaptwostmts();
return KEYWORD_PLUGIN_STMT;
- } else if(keyword_len == 8 && strnEQ(keyword_ptr, "looprest", 8) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "looprest") &&
keyword_active(hintkey_looprest_sv)) {
*op_ptr = parse_keyword_looprest();
return KEYWORD_PLUGIN_STMT;
- } else if(keyword_len == 14 && strnEQ(keyword_ptr, "scopelessblock", 14) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "scopelessblock") &&
keyword_active(hintkey_scopelessblock_sv)) {
*op_ptr = parse_keyword_scopelessblock();
return KEYWORD_PLUGIN_STMT;
- } else if(keyword_len == 10 && strnEQ(keyword_ptr, "stmtasexpr", 10) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "stmtasexpr") &&
keyword_active(hintkey_stmtasexpr_sv)) {
*op_ptr = parse_keyword_stmtasexpr();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 11 && strnEQ(keyword_ptr, "stmtsasexpr", 11) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "stmtsasexpr") &&
keyword_active(hintkey_stmtsasexpr_sv)) {
*op_ptr = parse_keyword_stmtsasexpr();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 9 && strnEQ(keyword_ptr, "loopblock", 9) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "loopblock") &&
keyword_active(hintkey_loopblock_sv)) {
*op_ptr = parse_keyword_loopblock();
return KEYWORD_PLUGIN_STMT;
- } else if(keyword_len == 11 && strnEQ(keyword_ptr, "blockasexpr", 11) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "blockasexpr") &&
keyword_active(hintkey_blockasexpr_sv)) {
*op_ptr = parse_keyword_blockasexpr();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 9 && strnEQ(keyword_ptr, "swaplabel", 9) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "swaplabel") &&
keyword_active(hintkey_swaplabel_sv)) {
*op_ptr = parse_keyword_swaplabel();
return KEYWORD_PLUGIN_STMT;
- } else if(keyword_len == 10 && strnEQ(keyword_ptr, "labelconst", 10) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "labelconst") &&
keyword_active(hintkey_labelconst_sv)) {
*op_ptr = parse_keyword_labelconst();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arrayfullexpr", 13) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "arrayfullexpr") &&
keyword_active(hintkey_arrayfullexpr_sv)) {
*op_ptr = parse_keyword_arrayfullexpr();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arraylistexpr", 13) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "arraylistexpr") &&
keyword_active(hintkey_arraylistexpr_sv)) {
*op_ptr = parse_keyword_arraylistexpr();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arraytermexpr", 13) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "arraytermexpr") &&
keyword_active(hintkey_arraytermexpr_sv)) {
*op_ptr = parse_keyword_arraytermexpr();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 14 && strnEQ(keyword_ptr, "arrayarithexpr", 14) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "arrayarithexpr") &&
keyword_active(hintkey_arrayarithexpr_sv)) {
*op_ptr = parse_keyword_arrayarithexpr();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 14 && strnEQ(keyword_ptr, "arrayexprflags", 14) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "arrayexprflags") &&
keyword_active(hintkey_arrayexprflags_sv)) {
*op_ptr = parse_keyword_arrayexprflags();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 5 && strnEQ(keyword_ptr, "DEFSV", 5) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "DEFSV") &&
keyword_active(hintkey_DEFSV_sv)) {
*op_ptr = parse_keyword_DEFSV();
return KEYWORD_PLUGIN_EXPR;
- } else if(keyword_len == 9 && strnEQ(keyword_ptr, "with_vars", 9) &&
+ } else if (memEQs(keyword_ptr, keyword_len, "with_vars") &&
keyword_active(hintkey_with_vars_sv)) {
*op_ptr = parse_keyword_with_vars();
return KEYWORD_PLUGIN_STMT;
+ } else if (memEQs(keyword_ptr, keyword_len, "join_with_space") &&
+ keyword_active(hintkey_join_with_space_sv)) {
+ *op_ptr = parse_join_with_space();
+ return KEYWORD_PLUGIN_EXPR;
} else {
+ assert(next_keyword_plugin != my_keyword_plugin);
return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
}
}
peep_xop(pTHX_ OP *o, OP *oldop)
{
dMY_CXT;
- av_push(MY_CXT.xop_record, newSVpvf("peep:%"UVxf, PTR2UV(o)));
- av_push(MY_CXT.xop_record, newSVpvf("oldop:%"UVxf, PTR2UV(oldop)));
+ av_push(MY_CXT.xop_record, newSVpvf("peep:%" UVxf, PTR2UV(o)));
+ av_push(MY_CXT.xop_record, newSVpvf("oldop:%" UVxf, PTR2UV(oldop)));
}
static I32
OP *aop, *bop;
U8 flags;
if (!(flag_svp && SvTRUE(*flag_svp) && (op->op_flags & OPf_KIDS) &&
- (aop = cBINOPx(op)->op_first) && (bop = OP_SIBLING(aop)) &&
- !OP_HAS_SIBLING(bop)))
+ (aop = cBINOPx(op)->op_first) && (bop = OpSIBLING(aop)) &&
+ !OpHAS_SIBLING(bop)))
return addissub_nxck_add(aTHX_ op);
flags = op->op_flags;
op_sibling_splice(op, NULL, 1, NULL); /* excise aop */
INCLUDE: numeric.xs
+void
+assertx(int x)
+ CODE:
+ /* this only needs to compile and checks that assert() can be
+ used this way syntactically */
+ (void)(assert(x), 1);
+ (void)(x);
+
MODULE = XS::APItest::utf8 PACKAGE = XS::APItest::utf8
int
RETVAL
AV *
-test_utf8n_to_uvchr(s, len, flags)
+test_utf8_to_bytes(bytes, lenp)
+ unsigned char * bytes
+ ssize_t lenp
+ PREINIT:
+ char * ret;
+ CODE:
+ RETVAL = newAV();
+ sv_2mortal((SV*)RETVAL);
+
+ ret = (char *) utf8_to_bytes(bytes, &lenp);
+ av_push(RETVAL, newSVpv(ret, 0));
+ av_push(RETVAL, newSViv(lenp));
+ av_push(RETVAL, newSVpv((const char *) bytes, 0));
+
+ OUTPUT:
+ RETVAL
+
+AV *
+test_utf8n_to_uvchr_msgs(s, len, flags)
+ char *s
+ STRLEN len
+ U32 flags
+ PREINIT:
+ STRLEN retlen;
+ UV ret;
+ U32 errors;
+ AV *msgs = NULL;
+
+ CODE:
+ RETVAL = newAV();
+ sv_2mortal((SV*)RETVAL);
+
+ ret = utf8n_to_uvchr_msgs((U8*) s,
+ len,
+ &retlen,
+ flags,
+ &errors,
+ &msgs);
+
+ /* Returns the return value in [0]; <retlen> in [1], <errors> in [2] */
+ av_push(RETVAL, newSVuv(ret));
+ if (retlen == (STRLEN) -1) {
+ av_push(RETVAL, newSViv(-1));
+ }
+ else {
+ av_push(RETVAL, newSVuv(retlen));
+ }
+ av_push(RETVAL, newSVuv(errors));
+
+ /* And any messages in [3] */
+ if (msgs) {
+ av_push(RETVAL, newRV_noinc((SV*)msgs));
+ }
+
+ OUTPUT:
+ RETVAL
+
+AV *
+test_utf8n_to_uvchr_error(s, len, flags)
+
+ char *s
+ STRLEN len
+ U32 flags
+ PREINIT:
+ STRLEN retlen;
+ UV ret;
+ U32 errors;
+
+ CODE:
+ /* Now that utf8n_to_uvchr() is a trivial wrapper for
+ * utf8n_to_uvchr_error(), call the latter with the inputs. It always
+ * asks for the actual length to be returned and errors to be returned
+ *
+ * Length to assume <s> is; not checked, so could have buffer overflow
+ */
+ RETVAL = newAV();
+ sv_2mortal((SV*)RETVAL);
+
+ ret = utf8n_to_uvchr_error((U8*) s,
+ len,
+ &retlen,
+ flags,
+ &errors);
+
+ /* Returns the return value in [0]; <retlen> in [1], <errors> in [2] */
+ av_push(RETVAL, newSVuv(ret));
+ if (retlen == (STRLEN) -1) {
+ av_push(RETVAL, newSViv(-1));
+ }
+ else {
+ av_push(RETVAL, newSVuv(retlen));
+ }
+ av_push(RETVAL, newSVuv(errors));
+
+ OUTPUT:
+ RETVAL
+
+AV *
+test_valid_utf8_to_uvchr(s)
SV *s
- SV *len
- SV *flags
PREINIT:
STRLEN retlen;
UV ret;
- STRLEN slen;
CODE:
/* Call utf8n_to_uvchr() with the inputs. It always asks for the
RETVAL = newAV();
sv_2mortal((SV*)RETVAL);
- ret
- = utf8n_to_uvchr((U8*) SvPV(s, slen), SvUV(len), &retlen, SvUV(flags));
+ ret = valid_utf8_to_uvchr((U8*) SvPV_nolen(s), &retlen);
/* Returns the return value in [0]; <retlen> in [1] */
av_push(RETVAL, newSVuv(ret));
- if (retlen == (STRLEN) -1) {
- av_push(RETVAL, newSViv(-1));
+ av_push(RETVAL, newSVuv(retlen));
+
+ OUTPUT:
+ RETVAL
+
+SV *
+test_uvchr_to_utf8_flags(uv, flags)
+
+ SV *uv
+ SV *flags
+ PREINIT:
+ U8 dest[UTF8_MAXBYTES + 1];
+ U8 *ret;
+
+ CODE:
+ /* Call uvchr_to_utf8_flags() with the inputs. */
+ ret = uvchr_to_utf8_flags(dest, SvUV(uv), SvUV(flags));
+ if (! ret) {
+ XSRETURN_UNDEF;
+ }
+ RETVAL = newSVpvn((char *) dest, ret - dest);
+
+ OUTPUT:
+ RETVAL
+
+AV *
+test_uvchr_to_utf8_flags_msgs(uv, flags)
+
+ SV *uv
+ SV *flags
+ PREINIT:
+ U8 dest[UTF8_MAXBYTES + 1];
+ U8 *ret;
+
+ CODE:
+ HV *msgs = NULL;
+ RETVAL = newAV();
+ sv_2mortal((SV*)RETVAL);
+
+ ret = uvchr_to_utf8_flags_msgs(dest, SvUV(uv), SvUV(flags), &msgs);
+
+ if (ret) {
+ av_push(RETVAL, newSVpvn((char *) dest, ret - dest));
}
else {
- av_push(RETVAL, newSVuv(retlen));
+ av_push(RETVAL, &PL_sv_undef);
+ }
+
+ if (msgs) {
+ av_push(RETVAL, newRV_noinc((SV*)msgs));
}
OUTPUT:
XS_APIVERSION_BOOTCHECK;
XSRETURN_EMPTY;
+void
+xsreturn( int len )
+ PPCODE:
+ int i = 0;
+ EXTEND( SP, len );
+ for ( ; i < len; i++ ) {
+ ST(i) = sv_2mortal( newSViv(i) );
+ }
+ XSRETURN( len );
+
+void
+xsreturn_iv()
+ PPCODE:
+ XSRETURN_IV(I32_MIN + 1);
+
+void
+xsreturn_uv()
+ PPCODE:
+ XSRETURN_UV( (U32)((1U<<31) + 1) );
+
+void
+xsreturn_nv()
+ PPCODE:
+ XSRETURN_NV(0.25);
+
+void
+xsreturn_pv()
+ PPCODE:
+ XSRETURN_PV("returned");
+
+void
+xsreturn_pvn()
+ PPCODE:
+ XSRETURN_PVN("returned too much",8);
+
+void
+xsreturn_no()
+ PPCODE:
+ XSRETURN_NO;
+
+void
+xsreturn_yes()
+ PPCODE:
+ XSRETURN_YES;
+
+void
+xsreturn_undef()
+ PPCODE:
+ XSRETURN_UNDEF;
+
+void
+xsreturn_empty()
+ PPCODE:
+ XSRETURN_EMPTY;
+
MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
void
IV level
CODE:
if (level) {
- croak("level must be zero, not %"IVdf, level);
+ croak("level must be zero, not %" IVdf, level);
}
RETVAL = (cop_hints_fetch_sv(PL_curcop, key, 0, 0) != &PL_sv_placeholder);
OUTPUT:
IV level
CODE:
if (level) {
- croak("level must be zero, not %"IVdf, level);
+ croak("level must be zero, not %" IVdf, level);
}
RETVAL = cop_hints_fetch_sv(PL_curcop, key, 0, 0);
SvREFCNT_inc(RETVAL);
test_force_keys(HV *hv)
PREINIT:
HE *he;
- STRLEN count = 0;
+ SSize_t count = 0;
PPCODE:
hv_iterinit(hv);
he = hv_iternext(hv);
unop->op_next = NULL;
kid->op_next = (OP*)unop;
- av_push(MY_CXT.xop_record, newSVpvf("unop:%"UVxf, PTR2UV(unop)));
- av_push(MY_CXT.xop_record, newSVpvf("kid:%"UVxf, PTR2UV(kid)));
+ av_push(MY_CXT.xop_record, newSVpvf("unop:%" UVxf, PTR2UV(unop)));
+ av_push(MY_CXT.xop_record, newSVpvf("kid:%" UVxf, PTR2UV(kid)));
av_push(MY_CXT.xop_record, newSVpvf("NAME:%s", OP_NAME((OP*)unop)));
av_push(MY_CXT.xop_record, newSVpvf("DESC:%s", OP_DESC((OP*)unop)));
mXPUSHu(3);
XSRETURN(3);
+
+ # test_EXTEND(): excerise the EXTEND() macro.
+ # After calling EXTEND(), it also does *(p+n) = NULL and
+ # *PL_stack_max = NULL to allow valgrind etc to spot if the stack hasn't
+ # actually been extended properly.
+ #
+ # max_offset specifies the SP to use. It is treated as a signed offset
+ # from PL_stack_max.
+ # nsv is the SV holding the value of n indicating how many slots
+ # to extend the stack by.
+ # use_ss is a boolean indicating that n should be cast to a SSize_t
+
+void
+test_EXTEND(max_offset, nsv, use_ss)
+ IV max_offset;
+ SV *nsv;
+ bool use_ss;
+PREINIT:
+ SV **sp = PL_stack_max + max_offset;
+PPCODE:
+ if (use_ss) {
+ SSize_t n = (SSize_t)SvIV(nsv);
+ EXTEND(sp, n);
+ *(sp + n) = NULL;
+ }
+ else {
+ IV n = SvIV(nsv);
+ EXTEND(sp, n);
+ *(sp + n) = NULL;
+ }
+ *PL_stack_max = NULL;
+
+
void
call_sv_C()
PREINIT:
I32 retcnt;
SV * errsv;
char * errstr;
+ STRLEN errlen;
SV * miscsv = sv_newmortal();
HV * hv = (HV*)sv_2mortal((SV*)newHV());
CODE:
only current internal behavior, these tests can be changed in the
future if necessery */
PUSHMARK(SP);
- retcnt = call_sv(&PL_sv_yes, 0); /* does nothing */
+ retcnt = call_sv(&PL_sv_yes, G_EVAL);
SPAGAIN;
SP -= retcnt;
+ errsv = ERRSV;
+ errstr = SvPV(errsv, errlen);
+ if(memBEGINs(errstr, errlen, "Undefined subroutine &main::1 called at")) {
+ PUSHMARK(SP);
+ retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
+ SPAGAIN;
+ SP -= retcnt;
+ }
PUSHMARK(SP);
retcnt = call_sv(&PL_sv_no, G_EVAL);
SPAGAIN;
SP -= retcnt;
errsv = ERRSV;
- errstr = SvPV_nolen(errsv);
- if(strnEQ(errstr, "Undefined subroutine &main:: called at",
- sizeof("Undefined subroutine &main:: called at") - 1)) {
+ errstr = SvPV(errsv, errlen);
+ if(memBEGINs(errstr, errlen, "Undefined subroutine &main:: called at")) {
PUSHMARK(SP);
retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
SPAGAIN;
SPAGAIN;
SP -= retcnt;
errsv = ERRSV;
- errstr = SvPV_nolen(errsv);
- if(strnEQ(errstr, "Can't use an undefined value as a subroutine reference at",
- sizeof("Can't use an undefined value as a subroutine reference at") - 1)) {
+ errstr = SvPV(errsv, errlen);
+ if(memBEGINs(errstr, errlen, "Can't use an undefined value as a subroutine reference at")) {
PUSHMARK(SP);
retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
SPAGAIN;
SPAGAIN;
SP -= retcnt;
errsv = ERRSV;
- errstr = SvPV_nolen(errsv);
- if(strnEQ(errstr, "Not a CODE reference at",
- sizeof("Not a CODE reference at") - 1)) {
+ errstr = SvPV(errsv, errlen);
+ if(memBEGINs(errstr, errlen, "Not a CODE reference at")) {
PUSHMARK(SP);
retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
SPAGAIN;
PUSHs(sv_2mortal(newSViv(i)));
void
+call_argv(subname, flags, ...)
+ char* subname
+ I32 flags
+ PREINIT:
+ I32 i;
+ char *tmpary[4];
+ PPCODE:
+ for (i=0; i<items-2; i++)
+ tmpary[i] = SvPV_nolen(ST(i+2)); /* ignore first two args */
+ tmpary[i] = NULL;
+ PUTBACK;
+ i = call_argv(subname, flags, tmpary);
+ SPAGAIN;
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(i)));
+
+void
call_method(methname, flags, ...)
char* methname
I32 flags
gv = gv_fetchmethod_pvn_flags(stash, name, len, flags | SvUTF8(methname));
break;
}
+ case 4:
+ gv = gv_fetchmethod_pvn_flags(stash, SvPV_nolen(methname),
+ flags, SvUTF8(methname));
}
XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
}
XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
+SV *
+gv_const_sv(SV *name)
+ PREINIT:
+ GV *gv;
+ CODE:
+ if (SvPOK(name)) {
+ HV *stash = gv_stashpv("main",0);
+ HE *he = hv_fetch_ent(stash, name, 0, 0);
+ gv = (GV *)HeVAL(he);
+ }
+ else {
+ gv = (GV *)name;
+ }
+ RETVAL = gv_const_sv(gv);
+ if (!RETVAL)
+ XSRETURN_EMPTY;
+ RETVAL = newSVsv(RETVAL);
+ OUTPUT:
+ RETVAL
+
void
whichsig_type(namesv, type)
SV* namesv
len = SvUV(ST(1));
}
/* Mortalise this right now, as we'll be testing croak()s */
- dest = sv_2mortal(newSV(len * 3 / 2 + 1));
+ dest = sv_2mortal(newSV(len * 2 + 1));
if (ix) {
utf16_to_utf8_reversed(source, (U8 *)SvPVX(dest), len, &got);
} else {
CV *troc_cv, *tsh_cv;
Perl_call_checker ckfun;
SV *ckobj;
+ U32 ckflags;
CODE:
-#define check_cc(cv, xckfun, xckobj) \
+#define check_cc(cv, xckfun, xckobj, xckflags) \
do { \
cv_get_call_checker((cv), &ckfun, &ckobj); \
- if (ckfun != (xckfun)) croak_fail_ne(FPTR2DPTR(void *, ckfun), xckfun); \
- if (ckobj != (xckobj)) croak_fail_ne(FPTR2DPTR(void *, ckobj), xckobj); \
+ if (ckfun != (xckfun)) croak_fail_nep(FPTR2DPTR(void *, ckfun), xckfun); \
+ if (ckobj != (xckobj)) croak_fail_nep(FPTR2DPTR(void *, ckobj), xckobj); \
+ cv_get_call_checker_flags((cv), CALL_CHECKER_REQUIRE_GV, &ckfun, &ckobj, &ckflags); \
+ if (ckfun != (xckfun)) croak_fail_nep(FPTR2DPTR(void *, ckfun), xckfun); \
+ if (ckobj != (xckobj)) croak_fail_nep(FPTR2DPTR(void *, ckobj), xckobj); \
+ if (ckflags != CALL_CHECKER_REQUIRE_GV) croak_fail_nei(ckflags, CALL_CHECKER_REQUIRE_GV); \
+ cv_get_call_checker_flags((cv), 0, &ckfun, &ckobj, &ckflags); \
+ if (ckfun != (xckfun)) croak_fail_nep(FPTR2DPTR(void *, ckfun), xckfun); \
+ if (ckobj != (xckobj)) croak_fail_nep(FPTR2DPTR(void *, ckobj), xckobj); \
+ if (ckflags != (xckflags)) croak_fail_nei(ckflags, (xckflags)); \
} while(0)
troc_cv = get_cv("XS::APItest::test_rv2cv_op_cv", 0);
tsh_cv = get_cv("XS::APItest::test_savehints", 0);
- check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
- check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
+ check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv, 0);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv, 0);
cv_set_call_checker(tsh_cv, Perl_ck_entersub_args_proto_or_list,
&PL_sv_yes);
- check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
- check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes);
+ check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv, 0);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes, CALL_CHECKER_REQUIRE_GV);
cv_set_call_checker(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
- check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
- check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes);
+ check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no, CALL_CHECKER_REQUIRE_GV);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes, CALL_CHECKER_REQUIRE_GV);
cv_set_call_checker(tsh_cv, Perl_ck_entersub_args_proto_or_list,
(SV*)tsh_cv);
- check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
- check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
+ check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no, CALL_CHECKER_REQUIRE_GV);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv, 0);
cv_set_call_checker(troc_cv, Perl_ck_entersub_args_proto_or_list,
(SV*)troc_cv);
- check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
- check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
+ check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv, 0);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv, 0);
if (SvMAGICAL((SV*)troc_cv) || SvMAGIC((SV*)troc_cv)) croak_fail();
if (SvMAGICAL((SV*)tsh_cv) || SvMAGIC((SV*)tsh_cv)) croak_fail();
+ cv_set_call_checker_flags(tsh_cv, Perl_ck_entersub_args_proto_or_list,
+ &PL_sv_yes, 0);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes, 0);
+ cv_set_call_checker_flags(tsh_cv, Perl_ck_entersub_args_proto_or_list,
+ &PL_sv_yes, CALL_CHECKER_REQUIRE_GV);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes, CALL_CHECKER_REQUIRE_GV);
+ cv_set_call_checker_flags(tsh_cv, Perl_ck_entersub_args_proto_or_list,
+ (SV*)tsh_cv, 0);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv, 0);
+ if (SvMAGICAL((SV*)tsh_cv) || SvMAGIC((SV*)tsh_cv)) croak_fail();
+ cv_set_call_checker_flags(tsh_cv, Perl_ck_entersub_args_proto_or_list,
+ &PL_sv_yes, CALL_CHECKER_REQUIRE_GV);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes, CALL_CHECKER_REQUIRE_GV);
+ cv_set_call_checker_flags(tsh_cv, Perl_ck_entersub_args_proto_or_list,
+ (SV*)tsh_cv, CALL_CHECKER_REQUIRE_GV);
+ check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv, 0);
+ if (SvMAGICAL((SV*)tsh_cv) || SvMAGIC((SV*)tsh_cv)) croak_fail();
#undef check_cc
void
test_cophh()
PREINIT:
COPHH *a, *b;
+#ifdef EBCDIC
+ SV* key_sv;
+ char * key_name;
+ STRLEN key_len;
+#endif
CODE:
#define check_ph(EXPR) \
do { if((EXPR) != &PL_sv_placeholder) croak("fail"); } while(0)
check_iv(cophh_fetch_pvs(a, "foo_3", 0), 333);
check_iv(cophh_fetch_pvs(a, "foo_4", 0), 444);
check_ph(cophh_fetch_pvs(a, "foo_5", 0));
- a = cophh_store_pvs(a, "foo_1", msviv(11111), COPHH_KEY_UTF8);
+ a = cophh_store_pvs(a, "foo_1", msviv(11111), COPHH_KEY_UTF8);
a = cophh_store_pvs(a, "foo_\xaa", msviv(123), 0);
+#ifndef EBCDIC
a = cophh_store_pvs(a, "foo_\xc2\xbb", msviv(456), COPHH_KEY_UTF8);
+#else
+ /* On EBCDIC, we need to translate the UTF-8 in the ASCII test to the
+ * equivalent UTF-EBCDIC for the code page. This is done at runtime
+ * (with the helper function in this file). Therefore we can't use
+ * cophhh_store_pvs(), as we don't have literal string */
+ key_sv = sv_2mortal(newSVpvs("foo_"));
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xc2\xbb"));
+ key_name = SvPV(key_sv, key_len);
+ a = cophh_store_pvn(a, key_name, key_len, 0, msviv(456), COPHH_KEY_UTF8);
+#endif
+#ifndef EBCDIC
a = cophh_store_pvs(a, "foo_\xc3\x8c", msviv(789), COPHH_KEY_UTF8);
+#else
+ sv_setpvs(key_sv, "foo_");
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xc3\x8c"));
+ key_name = SvPV(key_sv, key_len);
+ a = cophh_store_pvn(a, key_name, key_len, 0, msviv(789), COPHH_KEY_UTF8);
+#endif
+#ifndef EBCDIC
a = cophh_store_pvs(a, "foo_\xd9\xa6", msviv(666), COPHH_KEY_UTF8);
+#else
+ sv_setpvs(key_sv, "foo_");
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xd9\xa6"));
+ key_name = SvPV(key_sv, key_len);
+ a = cophh_store_pvn(a, key_name, key_len, 0, msviv(666), COPHH_KEY_UTF8);
+#endif
check_iv(cophh_fetch_pvs(a, "foo_1", 0), 11111);
check_iv(cophh_fetch_pvs(a, "foo_1", COPHH_KEY_UTF8), 11111);
check_iv(cophh_fetch_pvs(a, "foo_\xaa", 0), 123);
+#ifndef EBCDIC
check_iv(cophh_fetch_pvs(a, "foo_\xc2\xaa", COPHH_KEY_UTF8), 123);
check_ph(cophh_fetch_pvs(a, "foo_\xc2\xaa", 0));
+#else
+ sv_setpvs(key_sv, "foo_");
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xc2\xaa"));
+ key_name = SvPV(key_sv, key_len);
+ check_iv(cophh_fetch_pvn(a, key_name, key_len, 0, COPHH_KEY_UTF8), 123);
+ check_ph(cophh_fetch_pvn(a, key_name, key_len, 0, 0));
+#endif
check_iv(cophh_fetch_pvs(a, "foo_\xbb", 0), 456);
+#ifndef EBCDIC
check_iv(cophh_fetch_pvs(a, "foo_\xc2\xbb", COPHH_KEY_UTF8), 456);
check_ph(cophh_fetch_pvs(a, "foo_\xc2\xbb", 0));
+#else
+ sv_setpvs(key_sv, "foo_");
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xc2\xbb"));
+ key_name = SvPV(key_sv, key_len);
+ check_iv(cophh_fetch_pvn(a, key_name, key_len, 0, COPHH_KEY_UTF8), 456);
+ check_ph(cophh_fetch_pvn(a, key_name, key_len, 0, 0));
+#endif
check_iv(cophh_fetch_pvs(a, "foo_\xcc", 0), 789);
+#ifndef EBCDIC
check_iv(cophh_fetch_pvs(a, "foo_\xc3\x8c", COPHH_KEY_UTF8), 789);
check_ph(cophh_fetch_pvs(a, "foo_\xc2\x8c", 0));
+#else
+ sv_setpvs(key_sv, "foo_");
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xc3\x8c"));
+ key_name = SvPV(key_sv, key_len);
+ check_iv(cophh_fetch_pvn(a, key_name, key_len, 0, COPHH_KEY_UTF8), 789);
+ check_ph(cophh_fetch_pvn(a, key_name, key_len, 0, 0));
+#endif
+#ifndef EBCDIC
check_iv(cophh_fetch_pvs(a, "foo_\xd9\xa6", COPHH_KEY_UTF8), 666);
check_ph(cophh_fetch_pvs(a, "foo_\xd9\xa6", 0));
+#else
+ sv_setpvs(key_sv, "foo_");
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xd9\xa6"));
+ key_name = SvPV(key_sv, key_len);
+ check_iv(cophh_fetch_pvn(a, key_name, key_len, 0, COPHH_KEY_UTF8), 666);
+ check_ph(cophh_fetch_pvn(a, key_name, key_len, 0, 0));
+#endif
ENTER;
SAVEFREECOPHH(a);
LEAVE;
cop = &PL_compiling;
Perl_cop_store_label(aTHX_ cop, "foo", 3, 0);
label = Perl_cop_fetch_label(aTHX_ cop, &len, &utf8);
- if (strcmp(label,"foo")) croak("fail # cop_fetch_label label");
+ if (strNE(label,"foo")) croak("fail # cop_fetch_label label");
if (len != 3) croak("fail # cop_fetch_label len");
if (utf8) croak("fail # cop_fetch_label utf8");
/* SMALL GERMAN UMLAUT A */
Perl_cop_store_label(aTHX_ cop, "fo\xc3\xa4", 4, SVf_UTF8);
label = Perl_cop_fetch_label(aTHX_ cop, &len, &utf8);
- if (strcmp(label,"fo\xc3\xa4")) croak("fail # cop_fetch_label label");
+ if (strNE(label,"fo\xc3\xa4")) croak("fail # cop_fetch_label label");
if (len != 4) croak("fail # cop_fetch_label len");
if (!utf8) croak("fail # cop_fetch_label utf8");
example_cophh_2hv()
PREINIT:
COPHH *a;
+#ifdef EBCDIC
+ SV* key_sv;
+ char * key_name;
+ STRLEN key_len;
+#endif
CODE:
#define msviv(VALUE) sv_2mortal(newSViv(VALUE))
a = cophh_new_empty();
a = cophh_store_pvs(a, "foo_0", msviv(999), 0);
a = cophh_store_pvs(a, "foo_1", msviv(111), 0);
a = cophh_store_pvs(a, "foo_\xaa", msviv(123), 0);
+#ifndef EBCDIC
a = cophh_store_pvs(a, "foo_\xc2\xbb", msviv(456), COPHH_KEY_UTF8);
+#else
+ key_sv = sv_2mortal(newSVpvs("foo_"));
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xc2\xbb"));
+ key_name = SvPV(key_sv, key_len);
+ a = cophh_store_pvn(a, key_name, key_len, 0, msviv(456), COPHH_KEY_UTF8);
+#endif
+#ifndef EBCDIC
a = cophh_store_pvs(a, "foo_\xc3\x8c", msviv(789), COPHH_KEY_UTF8);
+#else
+ sv_setpvs(key_sv, "foo_");
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xc3\x8c"));
+ key_name = SvPV(key_sv, key_len);
+ a = cophh_store_pvn(a, key_name, key_len, 0, msviv(789), COPHH_KEY_UTF8);
+#endif
+#ifndef EBCDIC
a = cophh_store_pvs(a, "foo_\xd9\xa6", msviv(666), COPHH_KEY_UTF8);
+#else
+ sv_setpvs(key_sv, "foo_");
+ cat_utf8a2n(key_sv, STR_WITH_LEN("\xd9\xa6"));
+ key_name = SvPV(key_sv, key_len);
+ a = cophh_store_pvn(a, key_name, key_len, 0, msviv(666), COPHH_KEY_UTF8);
+#endif
a = cophh_delete_pvs(a, "foo_0", 0);
a = cophh_delete_pvs(a, "foo_2", 0);
RETVAL = cophh_2hv(a, 0);
#define iv_op(iv) newSVOP(OP_CONST, 0, newSViv(iv))
#define check_op(o, expect) \
do { \
- if (strcmp(test_op_list_describe(o), (expect))) \
+ if (strNE(test_op_list_describe(o), (expect))) \
croak("fail %s %s", test_op_list_describe(o), (expect)); \
} while(0)
a = op_append_elem(OP_LIST, NULL, NULL);
MULTICALL;
}
POP_MULTICALL;
- PERL_UNUSED_VAR(newsp);
XSRETURN_UNDEF;
}
+=pod
+
+multicall_return(): call the passed sub once in the specificed context
+and return whatever it returns
+
+=cut
+
+void
+multicall_return(block, context)
+ SV *block
+ I32 context
+PROTOTYPE: &$
+CODE:
+{
+ dSP;
+ dMULTICALL;
+ GV *gv;
+ HV *stash;
+ I32 gimme = context;
+ CV *cv;
+ AV *av;
+ SV **p;
+ SSize_t i, size;
+
+ cv = sv_2cv(block, &stash, &gv, 0);
+ if (cv == Nullcv) {
+ croak("multicall_return not a subroutine reference");
+ }
+ PUSH_MULTICALL(cv);
+
+ MULTICALL;
+
+ /* copy returned values into an array so they're not freed during
+ * POP_MULTICALL */
+
+ av = newAV();
+ SPAGAIN;
+
+ switch (context) {
+ case G_VOID:
+ break;
+
+ case G_SCALAR:
+ av_push(av, SvREFCNT_inc(TOPs));
+ break;
+
+ case G_ARRAY:
+ for (p = PL_stack_base + 1; p <= SP; p++)
+ av_push(av, SvREFCNT_inc(*p));
+ break;
+ }
+
+ POP_MULTICALL;
+
+ size = AvFILLp(av) + 1;
+ EXTEND(SP, size);
+ for (i = 0; i < size; i++)
+ ST(i) = *av_fetch(av, i, FALSE);
+ sv_2mortal((SV*)av);
+ XSRETURN(size);
+}
+
+
#ifdef USE_ITHREADS
void
PERL_SET_CONTEXT(interp);
POPSTACK_TO(PL_mainstack);
- dounwind(-1);
+ if (cxstack_ix >= 0) {
+ dounwind(-1);
+ cx_popblock(cxstack);
+ }
LEAVE_SCOPE(0);
-
- while (interp->Iscopestack_ix > 1)
- LEAVE;
+ PL_scopestack_ix = oldscope;
FREETMPS;
perl_destruct(interp);
hintkey_arrayexprflags_sv = newSVpvs_share("XS::APItest/arrayexprflags");
hintkey_DEFSV_sv = newSVpvs_share("XS::APItest/DEFSV");
hintkey_with_vars_sv = newSVpvs_share("XS::APItest/with_vars");
- next_keyword_plugin = PL_keyword_plugin;
- PL_keyword_plugin = my_keyword_plugin;
+ hintkey_join_with_space_sv = newSVpvs_share("XS::APItest/join_with_space");
+ wrap_keyword_plugin(my_keyword_plugin, &next_keyword_plugin);
}
void
CODE:
{
const I32 floor = start_subparse(0,0);
+ OP *o;
/* The slab allocator does not like CvROOT being set. */
CvROOT(PL_compcv) = (OP *)1;
- op_free(newFOROP(0, 0, newOP(OP_PUSHMARK, 0), 0, 0));
+ o = newFOROP(0, 0, newOP(OP_PUSHMARK, 0), 0, 0);
+#ifdef PERL_OP_PARENT
+ if (cLOOPx(cUNOPo->op_first)->op_last->op_sibparent
+ != cUNOPo->op_first)
+ {
+ Perl_warn(aTHX_ "Op parent pointer is stale");
+ RETVAL = FALSE;
+ }
+ else
+#endif
+ /* If we do not crash before returning, the test passes. */
+ RETVAL = TRUE;
+ op_free(o);
CvROOT(PL_compcv) = NULL;
SvREFCNT_dec(PL_compcv);
LEAVE_SCOPE(floor);
- /* If we have not crashed yet, then the test passes. */
- RETVAL = TRUE;
}
OUTPUT:
RETVAL
SAVESPTR(PL_comppad_name); PL_comppad_name = PadlistNAMES(pl);
SAVESPTR(PL_comppad); PL_comppad = PadlistARRAY(pl)[1];
SAVESPTR(PL_curpad); PL_curpad = PadARRAY(PL_comppad);
- off = pad_add_name_sv(sv_2mortal(newSVpvf("&%"SVf,name)),
+ off = pad_add_name_sv(sv_2mortal(newSVpvf("&%" SVf,name)),
padadd_STATE, 0, 0);
SvREFCNT_dec(PL_curpad[off]);
PL_curpad[off] = SvREFCNT_inc(cv);
+ intro_my();
LEAVE;
}
sv_catpvn_flags(sv,s,len, SvUTF8(sv2) ? SV_CATUTF8 : SV_CATBYTES);
}
+bool
+test_newOP_CUSTOM()
+ CODE:
+ {
+ OP *o = newLISTOP(OP_CUSTOM, 0, NULL, NULL);
+ op_free(o);
+ o = newOP(OP_CUSTOM, 0);
+ op_free(o);
+ o = newUNOP(OP_CUSTOM, 0, NULL);
+ op_free(o);
+ o = newUNOP_AUX(OP_CUSTOM, 0, NULL, NULL);
+ op_free(o);
+ o = newMETHOP(OP_CUSTOM, 0, newOP(OP_NULL,0));
+ op_free(o);
+ o = newMETHOP_named(OP_CUSTOM, 0, newSV(0));
+ op_free(o);
+ o = newBINOP(OP_CUSTOM, 0, NULL, NULL);
+ op_free(o);
+ o = newPMOP(OP_CUSTOM, 0);
+ op_free(o);
+ o = newSVOP(OP_CUSTOM, 0, newSV(0));
+ op_free(o);
+#ifdef USE_ITHREADS
+ ENTER;
+ lex_start(NULL, NULL, 0);
+ {
+ I32 ix = start_subparse(FALSE,0);
+ o = newPADOP(OP_CUSTOM, 0, newSV(0));
+ op_free(o);
+ LEAVE_SCOPE(ix);
+ }
+ LEAVE;
+#endif
+ o = newPVOP(OP_CUSTOM, 0, NULL);
+ op_free(o);
+ o = newLOGOP(OP_CUSTOM, 0, newOP(OP_NULL,0), newOP(OP_NULL,0));
+ op_free(o);
+ o = newLOOPEX(OP_CUSTOM, newOP(OP_NULL,0));
+ op_free(o);
+ RETVAL = TRUE;
+ }
+ OUTPUT:
+ RETVAL
+
+void
+test_sv_catpvf(SV *fmtsv)
+ PREINIT:
+ SV *sv;
+ char *fmt;
+ CODE:
+ fmt = SvPV_nolen(fmtsv);
+ sv = sv_2mortal(newSVpvn("", 0));
+ sv_catpvf(sv, fmt, 5, 6, 7, 8);
+
+void
+load_module(flags, name, ...)
+ U32 flags
+ SV *name
+CODE:
+ if (items == 2) {
+ Perl_load_module(aTHX_ flags, SvREFCNT_inc(name), NULL);
+ } else if (items == 3) {
+ Perl_load_module(aTHX_ flags, SvREFCNT_inc(name), SvREFCNT_inc(ST(2)));
+ } else
+ Perl_croak(aTHX_ "load_module can't yet support %" IVdf " items",
+ (IV)items);
+
+SV *
+string_without_null(SV *sv)
+ CODE:
+ {
+ STRLEN len;
+ const char *s = SvPV(sv, len);
+ RETVAL = newSVpvn_flags(s, len, SvUTF8(sv));
+ *SvEND(RETVAL) = 0xff;
+ }
+ OUTPUT:
+ RETVAL
+
+CV *
+get_cv(SV *sv)
+ CODE:
+ {
+ STRLEN len;
+ const char *s = SvPV(sv, len);
+ RETVAL = get_cvn_flags(s, len, 0);
+ }
+ OUTPUT:
+ RETVAL
+
+CV *
+get_cv_flags(SV *sv, UV flags)
+ CODE:
+ {
+ STRLEN len;
+ const char *s = SvPV(sv, len);
+ RETVAL = get_cvn_flags(s, len, flags);
+ }
+ OUTPUT:
+ RETVAL
+
+PerlIO *
+PerlIO_stderr()
+
+OutputStream
+PerlIO_stdout()
+
+InputStream
+PerlIO_stdin()
+
+#undef FILE
+#define FILE NativeFile
+
+FILE *
+PerlIO_exportFILE(PerlIO *f, const char *mode)
+
MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
int
CODE:
sv_unmagicext(SvRV(sv), PERL_MAGIC_ext, ix ? &vtbl_bar : &vtbl_foo);
+void
+sv_magic(SV *sv, SV *thingy)
+CODE:
+ sv_magic(SvRV(sv), NULL, PERL_MAGIC_ext, (const char *)thingy, 0);
+
UV
test_get_vtbl()
PREINIT:
OUTPUT:
RETVAL
+
+ # attach ext magic to the SV pointed to by rsv that only has set magic,
+ # where that magic's job is to increment thingy
+
+void
+sv_magic_myset(SV *rsv, SV *thingy)
+CODE:
+ sv_magicext(SvRV(rsv), NULL, PERL_MAGIC_ext, &vtbl_myset,
+ (const char *)thingy, 0);
+
+
+
bool
test_isBLANK_uni(UV ord)
CODE:
RETVAL
bool
+test_isBLANK_uvchr(UV ord)
+ CODE:
+ RETVAL = isBLANK_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isBLANK_LC_uvchr(UV ord)
CODE:
RETVAL = isBLANK_LC_uvchr(ord);
RETVAL
bool
+test_isBLANK(UV ord)
+ CODE:
+ RETVAL = isBLANK(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isBLANK_A(UV ord)
CODE:
RETVAL = isBLANK_A(ord);
RETVAL
bool
-test_isBLANK_utf8(unsigned char * p)
+test_isBLANK_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isBLANK_utf8(p);
+
+ /* In this function and those that follow, the boolean 'type'
+ * indicates if to pass a malformed UTF-8 string to the tested macro
+ * (malformed by making it too short) */
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isBLANK_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isBLANK_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isBLANK_LC_utf8(unsigned char * p)
+test_isBLANK_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isBLANK_LC_utf8(p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isBLANK_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isBLANK_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
-test_isVERTWS_utf8(unsigned char * p)
+test_isVERTWS_uvchr(UV ord)
+ CODE:
+ RETVAL = isVERTWS_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
+test_isVERTWS_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isVERTWS_utf8(p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isVERTWS_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isVERTWS_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isUPPER_uvchr(UV ord)
+ CODE:
+ RETVAL = isUPPER_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isUPPER_LC_uvchr(UV ord)
CODE:
RETVAL = isUPPER_LC_uvchr(ord);
RETVAL
bool
+test_isUPPER(UV ord)
+ CODE:
+ RETVAL = isUPPER(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isUPPER_A(UV ord)
CODE:
RETVAL = isUPPER_A(ord);
RETVAL
bool
-test_isUPPER_utf8(unsigned char * p)
+test_isUPPER_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isUPPER_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isUPPER_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isUPPER_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isUPPER_LC_utf8(unsigned char * p)
+test_isUPPER_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isUPPER_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isUPPER_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isUPPER_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isLOWER_uvchr(UV ord)
+ CODE:
+ RETVAL = isLOWER_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isLOWER_LC_uvchr(UV ord)
CODE:
RETVAL = isLOWER_LC_uvchr(ord);
RETVAL
bool
+test_isLOWER(UV ord)
+ CODE:
+ RETVAL = isLOWER(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isLOWER_A(UV ord)
CODE:
RETVAL = isLOWER_A(ord);
RETVAL
bool
-test_isLOWER_utf8(unsigned char * p)
+test_isLOWER_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isLOWER_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isLOWER_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isLOWER_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isLOWER_LC_utf8(unsigned char * p)
+test_isLOWER_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isLOWER_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isLOWER_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isLOWER_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isALPHA_uvchr(UV ord)
+ CODE:
+ RETVAL = isALPHA_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isALPHA_LC_uvchr(UV ord)
CODE:
RETVAL = isALPHA_LC_uvchr(ord);
RETVAL
bool
+test_isALPHA(UV ord)
+ CODE:
+ RETVAL = isALPHA(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isALPHA_A(UV ord)
CODE:
RETVAL = isALPHA_A(ord);
RETVAL
bool
-test_isALPHA_utf8(unsigned char * p)
+test_isALPHA_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isALPHA_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isALPHA_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isALPHA_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isALPHA_LC_utf8(unsigned char * p)
+test_isALPHA_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isALPHA_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isALPHA_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isALPHA_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isWORDCHAR_uvchr(UV ord)
+ CODE:
+ RETVAL = isWORDCHAR_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isWORDCHAR_LC_uvchr(UV ord)
CODE:
RETVAL = isWORDCHAR_LC_uvchr(ord);
RETVAL
bool
+test_isWORDCHAR(UV ord)
+ CODE:
+ RETVAL = isWORDCHAR(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isWORDCHAR_A(UV ord)
CODE:
RETVAL = isWORDCHAR_A(ord);
RETVAL
bool
-test_isWORDCHAR_utf8(unsigned char * p)
+test_isWORDCHAR_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isWORDCHAR_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isWORDCHAR_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isWORDCHAR_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isWORDCHAR_LC_utf8(unsigned char * p)
+test_isWORDCHAR_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isWORDCHAR_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isWORDCHAR_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isWORDCHAR_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isALPHANUMERIC_uvchr(UV ord)
+ CODE:
+ RETVAL = isALPHANUMERIC_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isALPHANUMERIC_LC_uvchr(UV ord)
CODE:
RETVAL = isALPHANUMERIC_LC_uvchr(ord);
RETVAL
bool
+test_isALPHANUMERIC(UV ord)
+ CODE:
+ RETVAL = isALPHANUMERIC(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isALPHANUMERIC_A(UV ord)
CODE:
RETVAL = isALPHANUMERIC_A(ord);
RETVAL
bool
-test_isALPHANUMERIC_utf8(unsigned char * p)
+test_isALPHANUMERIC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
+ CODE:
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isALPHANUMERIC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isALPHANUMERIC_utf8(p);
+ }
+ OUTPUT:
+ RETVAL
+
+bool
+test_isALPHANUMERIC_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isALPHANUMERIC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isALPHANUMERIC_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isALPHANUMERIC_LC_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isALPHANUMERIC_LC_utf8(unsigned char * p)
+test_isALNUM(UV ord)
CODE:
- RETVAL = isALPHANUMERIC_LC_utf8( p);
+ RETVAL = isALNUM(ord);
OUTPUT:
RETVAL
RETVAL
bool
-test_isALNUM_utf8(unsigned char * p)
+test_isALNUM_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isALNUM_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isWORDCHAR_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isWORDCHAR_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isALNUM_LC_utf8(unsigned char * p)
+test_isALNUM_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isALNUM_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isWORDCHAR_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isWORDCHAR_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isDIGIT_uvchr(UV ord)
+ CODE:
+ RETVAL = isDIGIT_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isDIGIT_LC_uvchr(UV ord)
CODE:
RETVAL = isDIGIT_LC_uvchr(ord);
RETVAL
bool
-test_isDIGIT_utf8(unsigned char * p)
+test_isDIGIT_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
+ CODE:
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isDIGIT_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isDIGIT_utf8(p);
+ }
+ OUTPUT:
+ RETVAL
+
+bool
+test_isDIGIT_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isDIGIT_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isDIGIT_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isDIGIT_LC_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isDIGIT_LC_utf8(unsigned char * p)
+test_isDIGIT(UV ord)
CODE:
- RETVAL = isDIGIT_LC_utf8( p);
+ RETVAL = isDIGIT(ord);
OUTPUT:
RETVAL
RETVAL
bool
-test_isIDFIRST_uni(UV ord)
+test_isOCTAL(UV ord)
CODE:
- RETVAL = isIDFIRST_uni(ord);
+ RETVAL = isOCTAL(ord);
OUTPUT:
RETVAL
bool
-test_isIDFIRST_LC_uvchr(UV ord)
+test_isOCTAL_A(UV ord)
CODE:
- RETVAL = isIDFIRST_LC_uvchr(ord);
+ RETVAL = isOCTAL_A(ord);
OUTPUT:
RETVAL
bool
-test_isIDFIRST_A(UV ord)
+test_isOCTAL_L1(UV ord)
CODE:
- RETVAL = isIDFIRST_A(ord);
+ RETVAL = isOCTAL_L1(ord);
OUTPUT:
RETVAL
bool
-test_isIDFIRST_L1(UV ord)
+test_isIDFIRST_uni(UV ord)
CODE:
- RETVAL = isIDFIRST_L1(ord);
+ RETVAL = isIDFIRST_uni(ord);
OUTPUT:
RETVAL
bool
-test_isIDFIRST_LC(UV ord)
+test_isIDFIRST_uvchr(UV ord)
CODE:
- RETVAL = isIDFIRST_LC(ord);
+ RETVAL = isIDFIRST_uvchr(ord);
OUTPUT:
RETVAL
bool
-test_isIDFIRST_utf8(unsigned char * p)
+test_isIDFIRST_LC_uvchr(UV ord)
CODE:
- RETVAL = isIDFIRST_utf8( p);
+ RETVAL = isIDFIRST_LC_uvchr(ord);
OUTPUT:
RETVAL
bool
-test_isIDFIRST_LC_utf8(unsigned char * p)
+test_isIDFIRST(UV ord)
CODE:
- RETVAL = isIDFIRST_LC_utf8( p);
+ RETVAL = isIDFIRST(ord);
OUTPUT:
RETVAL
bool
-test_isIDCONT_uni(UV ord)
+test_isIDFIRST_A(UV ord)
CODE:
- RETVAL = isIDCONT_uni(ord);
+ RETVAL = isIDFIRST_A(ord);
OUTPUT:
RETVAL
bool
-test_isIDCONT_LC_uvchr(UV ord)
+test_isIDFIRST_L1(UV ord)
CODE:
- RETVAL = isIDCONT_LC_uvchr(ord);
+ RETVAL = isIDFIRST_L1(ord);
OUTPUT:
RETVAL
bool
-test_isIDCONT_A(UV ord)
+test_isIDFIRST_LC(UV ord)
CODE:
- RETVAL = isIDCONT_A(ord);
+ RETVAL = isIDFIRST_LC(ord);
OUTPUT:
RETVAL
bool
-test_isIDCONT_L1(UV ord)
+test_isIDFIRST_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isIDCONT_L1(ord);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isIDFIRST_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isIDFIRST_utf8(p);
+ }
+ OUTPUT:
+ RETVAL
+
+bool
+test_isIDFIRST_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
+ CODE:
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isIDFIRST_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isIDFIRST_LC_utf8(p);
+ }
+ OUTPUT:
+ RETVAL
+
+bool
+test_isIDCONT_uni(UV ord)
+ CODE:
+ RETVAL = isIDCONT_uni(ord);
+ OUTPUT:
+ RETVAL
+
+bool
+test_isIDCONT_uvchr(UV ord)
+ CODE:
+ RETVAL = isIDCONT_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
+test_isIDCONT_LC_uvchr(UV ord)
+ CODE:
+ RETVAL = isIDCONT_LC_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
+test_isIDCONT(UV ord)
+ CODE:
+ RETVAL = isIDCONT(ord);
+ OUTPUT:
+ RETVAL
+
+bool
+test_isIDCONT_A(UV ord)
+ CODE:
+ RETVAL = isIDCONT_A(ord);
+ OUTPUT:
+ RETVAL
+
+bool
+test_isIDCONT_L1(UV ord)
+ CODE:
+ RETVAL = isIDCONT_L1(ord);
OUTPUT:
RETVAL
RETVAL
bool
-test_isIDCONT_utf8(unsigned char * p)
+test_isIDCONT_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isIDCONT_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isIDCONT_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isIDCONT_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isIDCONT_LC_utf8(unsigned char * p)
+test_isIDCONT_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isIDCONT_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isIDCONT_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isIDCONT_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isSPACE_uvchr(UV ord)
+ CODE:
+ RETVAL = isSPACE_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isSPACE_LC_uvchr(UV ord)
CODE:
RETVAL = isSPACE_LC_uvchr(ord);
RETVAL
bool
+test_isSPACE(UV ord)
+ CODE:
+ RETVAL = isSPACE(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isSPACE_A(UV ord)
CODE:
RETVAL = isSPACE_A(ord);
RETVAL
bool
-test_isSPACE_utf8(unsigned char * p)
+test_isSPACE_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isSPACE_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isSPACE_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isSPACE_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isSPACE_LC_utf8(unsigned char * p)
+test_isSPACE_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isSPACE_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isSPACE_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isSPACE_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isASCII_uvchr(UV ord)
+ CODE:
+ RETVAL = isASCII_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isASCII_LC_uvchr(UV ord)
CODE:
RETVAL = isASCII_LC_uvchr(ord);
RETVAL
bool
+test_isASCII(UV ord)
+ CODE:
+ RETVAL = isASCII(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isASCII_A(UV ord)
CODE:
RETVAL = isASCII_A(ord);
RETVAL
bool
-test_isASCII_utf8(unsigned char * p)
+test_isASCII_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isASCII_utf8( p);
+#ifndef DEBUGGING
+ PERL_UNUSED_VAR(e);
+#endif
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isASCII_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isASCII_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isASCII_LC_utf8(unsigned char * p)
+test_isASCII_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isASCII_LC_utf8( p);
+#ifndef DEBUGGING
+ PERL_UNUSED_VAR(e);
+#endif
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isASCII_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isASCII_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isCNTRL_uvchr(UV ord)
+ CODE:
+ RETVAL = isCNTRL_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isCNTRL_LC_uvchr(UV ord)
CODE:
RETVAL = isCNTRL_LC_uvchr(ord);
RETVAL
bool
+test_isCNTRL(UV ord)
+ CODE:
+ RETVAL = isCNTRL(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isCNTRL_A(UV ord)
CODE:
RETVAL = isCNTRL_A(ord);
RETVAL
bool
-test_isCNTRL_utf8(unsigned char * p)
+test_isCNTRL_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isCNTRL_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isCNTRL_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isCNTRL_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isCNTRL_LC_utf8(unsigned char * p)
+test_isCNTRL_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isCNTRL_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isCNTRL_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isCNTRL_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isPRINT_uvchr(UV ord)
+ CODE:
+ RETVAL = isPRINT_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isPRINT_LC_uvchr(UV ord)
CODE:
RETVAL = isPRINT_LC_uvchr(ord);
RETVAL
bool
+test_isPRINT(UV ord)
+ CODE:
+ RETVAL = isPRINT(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isPRINT_A(UV ord)
CODE:
RETVAL = isPRINT_A(ord);
RETVAL
bool
-test_isPRINT_utf8(unsigned char * p)
+test_isPRINT_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isPRINT_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isPRINT_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isPRINT_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isPRINT_LC_utf8(unsigned char * p)
+test_isPRINT_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isPRINT_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isPRINT_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isPRINT_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isGRAPH_uvchr(UV ord)
+ CODE:
+ RETVAL = isGRAPH_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isGRAPH_LC_uvchr(UV ord)
CODE:
RETVAL = isGRAPH_LC_uvchr(ord);
RETVAL
bool
+test_isGRAPH(UV ord)
+ CODE:
+ RETVAL = isGRAPH(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isGRAPH_A(UV ord)
CODE:
RETVAL = isGRAPH_A(ord);
RETVAL
bool
-test_isGRAPH_utf8(unsigned char * p)
+test_isGRAPH_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isGRAPH_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isGRAPH_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isGRAPH_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isGRAPH_LC_utf8(unsigned char * p)
+test_isGRAPH_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isGRAPH_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isGRAPH_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isGRAPH_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isPUNCT_uvchr(UV ord)
+ CODE:
+ RETVAL = isPUNCT_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isPUNCT_LC_uvchr(UV ord)
CODE:
RETVAL = isPUNCT_LC_uvchr(ord);
RETVAL
bool
+test_isPUNCT(UV ord)
+ CODE:
+ RETVAL = isPUNCT(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isPUNCT_A(UV ord)
CODE:
RETVAL = isPUNCT_A(ord);
RETVAL
bool
-test_isPUNCT_utf8(unsigned char * p)
+test_isPUNCT_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isPUNCT_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isPUNCT_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isPUNCT_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isPUNCT_LC_utf8(unsigned char * p)
+test_isPUNCT_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isPUNCT_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isPUNCT_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isPUNCT_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isXDIGIT_uvchr(UV ord)
+ CODE:
+ RETVAL = isXDIGIT_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isXDIGIT_LC_uvchr(UV ord)
CODE:
RETVAL = isXDIGIT_LC_uvchr(ord);
RETVAL
bool
+test_isXDIGIT(UV ord)
+ CODE:
+ RETVAL = isXDIGIT(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isXDIGIT_A(UV ord)
CODE:
RETVAL = isXDIGIT_A(ord);
RETVAL
bool
-test_isXDIGIT_utf8(unsigned char * p)
+test_isXDIGIT_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isXDIGIT_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isXDIGIT_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isXDIGIT_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isXDIGIT_LC_utf8(unsigned char * p)
+test_isXDIGIT_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isXDIGIT_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isXDIGIT_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isXDIGIT_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
bool
+test_isPSXSPC_uvchr(UV ord)
+ CODE:
+ RETVAL = isPSXSPC_uvchr(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isPSXSPC_LC_uvchr(UV ord)
CODE:
RETVAL = isPSXSPC_LC_uvchr(ord);
RETVAL
bool
+test_isPSXSPC(UV ord)
+ CODE:
+ RETVAL = isPSXSPC(ord);
+ OUTPUT:
+ RETVAL
+
+bool
test_isPSXSPC_A(UV ord)
CODE:
RETVAL = isPSXSPC_A(ord);
RETVAL
bool
-test_isPSXSPC_utf8(unsigned char * p)
+test_isPSXSPC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isPSXSPC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isPSXSPC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isPSXSPC_utf8(p);
+ }
OUTPUT:
RETVAL
bool
-test_isPSXSPC_LC_utf8(unsigned char * p)
+test_isPSXSPC_LC_utf8(unsigned char * p, int type)
+ PREINIT:
+ const unsigned char * e;
CODE:
- RETVAL = isPSXSPC_LC_utf8( p);
+ if (type >= 0) {
+ e = p + UTF8SKIP(p) - type;
+ RETVAL = isPSXSPC_LC_utf8_safe(p, e);
+ }
+ else {
+ RETVAL = isPSXSPC_LC_utf8(p);
+ }
OUTPUT:
RETVAL
RETVAL
UV
-test_toLOWER(UV ord)
+test_OFFUNISKIP(UV ord)
CODE:
- RETVAL = toLOWER(ord);
+ RETVAL = OFFUNISKIP(ord);
OUTPUT:
RETVAL
-UV
-test_toLOWER_L1(UV ord)
+bool
+test_OFFUNI_IS_INVARIANT(UV ord)
CODE:
- RETVAL = toLOWER_L1(ord);
+ RETVAL = OFFUNI_IS_INVARIANT(ord);
OUTPUT:
RETVAL
-UV
-test_toLOWER_LC(UV ord)
+bool
+test_UVCHR_IS_INVARIANT(UV ord)
CODE:
- RETVAL = toLOWER_LC(ord);
+ RETVAL = UVCHR_IS_INVARIANT(ord);
OUTPUT:
RETVAL
-AV *
-test_toLOWER_uni(UV ord)
- PREINIT:
- U8 s[UTF8_MAXBYTES_CASE + 1];
- STRLEN len;
- AV *av;
- SV *utf8;
+bool
+test_UTF8_IS_INVARIANT(char ch)
CODE:
- av = newAV();
- av_push(av, newSVuv(toLOWER_uni(ord, s, &len)));
-
- utf8 = newSVpvn((char *) s, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
+ RETVAL = UTF8_IS_INVARIANT(ch);
OUTPUT:
RETVAL
-AV *
-test_toLOWER_utf8(SV * p)
- PREINIT:
- U8 *input;
- U8 s[UTF8_MAXBYTES_CASE + 1];
- STRLEN len;
- AV *av;
- SV *utf8;
+UV
+test_UVCHR_SKIP(UV ord)
CODE:
- input = (U8 *) SvPV(p, len);
- av = newAV();
- av_push(av, newSVuv(toLOWER_utf8(input, s, &len)));
-
- utf8 = newSVpvn((char *) s, len);
- SvUTF8_on(utf8);
- av_push(av, utf8);
-
- av_push(av, newSVuv(len));
- RETVAL = av;
+ RETVAL = UVCHR_SKIP(ord);
OUTPUT:
RETVAL
UV
-test_toFOLD(UV ord)
+test_UTF8_SKIP(char * ch)
CODE:
- RETVAL = toFOLD(ord);
+ RETVAL = UTF8_SKIP(ch);
OUTPUT:
RETVAL
-UV
-test_toFOLD_LC(UV ord)
+bool
+test_UTF8_IS_START(char ch)
CODE:
- RETVAL = toFOLD_LC(ord);
+ RETVAL = UTF8_IS_START(ch);
OUTPUT:
RETVAL
-AV *
-test_toFOLD_uni(UV ord)
- PREINIT:
- U8 s[UTF8_MAXBYTES_CASE + 1];
- STRLEN len;
+bool
+test_UTF8_IS_CONTINUATION(char ch)
+ CODE:
+ RETVAL = UTF8_IS_CONTINUATION(ch);
+ OUTPUT:
+ RETVAL
+
+bool
+test_UTF8_IS_CONTINUED(char ch)
+ CODE:
+ RETVAL = UTF8_IS_CONTINUED(ch);
+ OUTPUT:
+ RETVAL
+
+bool
+test_UTF8_IS_DOWNGRADEABLE_START(char ch)
+ CODE:
+ RETVAL = UTF8_IS_DOWNGRADEABLE_START(ch);
+ OUTPUT:
+ RETVAL
+
+bool
+test_UTF8_IS_ABOVE_LATIN1(char ch)
+ CODE:
+ RETVAL = UTF8_IS_ABOVE_LATIN1(ch);
+ OUTPUT:
+ RETVAL
+
+bool
+test_isUTF8_POSSIBLY_PROBLEMATIC(char ch)
+ CODE:
+ RETVAL = isUTF8_POSSIBLY_PROBLEMATIC(ch);
+ OUTPUT:
+ RETVAL
+
+STRLEN
+test_isUTF8_CHAR(char *s, STRLEN len)
+ CODE:
+ RETVAL = isUTF8_CHAR((U8 *) s, (U8 *) s + len);
+ OUTPUT:
+ RETVAL
+
+STRLEN
+test_isUTF8_CHAR_flags(char *s, STRLEN len, U32 flags)
+ CODE:
+ RETVAL = isUTF8_CHAR_flags((U8 *) s, (U8 *) s + len, flags);
+ OUTPUT:
+ RETVAL
+
+STRLEN
+test_isSTRICT_UTF8_CHAR(char *s, STRLEN len)
+ CODE:
+ RETVAL = isSTRICT_UTF8_CHAR((U8 *) s, (U8 *) s + len);
+ OUTPUT:
+ RETVAL
+
+STRLEN
+test_isC9_STRICT_UTF8_CHAR(char *s, STRLEN len)
+ CODE:
+ RETVAL = isC9_STRICT_UTF8_CHAR((U8 *) s, (U8 *) s + len);
+ OUTPUT:
+ RETVAL
+
+IV
+test_is_utf8_valid_partial_char_flags(char *s, STRLEN len, U32 flags)
+ CODE:
+ /* RETVAL should be bool (here and in tests below), but making it IV
+ * allows us to test it returning 0 or 1 */
+ RETVAL = is_utf8_valid_partial_char_flags((U8 *) s, (U8 *) s + len, flags);
+ OUTPUT:
+ RETVAL
+
+IV
+test_is_utf8_string(char *s, STRLEN len)
+ CODE:
+ RETVAL = is_utf8_string((U8 *) s, len);
+ OUTPUT:
+ RETVAL
+
+#define WORDSIZE sizeof(PERL_UINTMAX_T)
+
+AV *
+test_is_utf8_invariant_string_loc(unsigned char *s, STRLEN offset, STRLEN len)
+ PREINIT:
+ AV *av;
+ const U8 * ep = NULL;
+ PERL_UINTMAX_T* copy;
+ CODE:
+ /* 'offset' is number of bytes past a word boundary the testing of 's'
+ * is to start at. Allocate space that does start at the word
+ * boundary, and copy 's' to the correct offset past it. Then call the
+ * tested function with that position */
+ Newx(copy, 1 + ((len + WORDSIZE - 1) / WORDSIZE), PERL_UINTMAX_T);
+ Copy(s, (U8 *) copy + offset, len, U8);
+ av = newAV();
+ av_push(av, newSViv(is_utf8_invariant_string_loc((U8 *) copy + offset, len, &ep)));
+ av_push(av, newSViv(ep - ((U8 *) copy + offset)));
+ RETVAL = av;
+ Safefree(copy);
+ OUTPUT:
+ RETVAL
+
+STRLEN
+test_variant_under_utf8_count(unsigned char *s, STRLEN offset, STRLEN len)
+ PREINIT:
+ PERL_UINTMAX_T * copy;
+ CODE:
+ Newx(copy, 1 + ((len + WORDSIZE - 1) / WORDSIZE), PERL_UINTMAX_T);
+ Copy(s, (U8 *) copy + offset, len, U8);
+ RETVAL = variant_under_utf8_count((U8 *) copy + offset, (U8 *) copy + offset + len);
+ Safefree(copy);
+ OUTPUT:
+ RETVAL
+
+STRLEN
+test_utf8_length(unsigned char *s, STRLEN offset, STRLEN len)
+CODE:
+ RETVAL = utf8_length(s + offset, s + len);
+OUTPUT:
+ RETVAL
+
+AV *
+test_is_utf8_string_loc(char *s, STRLEN len)
+ PREINIT:
+ AV *av;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_utf8_string_loc((U8 *) s, len, &ep)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_is_utf8_string_loclen(char *s, STRLEN len)
+ PREINIT:
+ AV *av;
+ STRLEN ret_len;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_utf8_string_loclen((U8 *) s, len, &ep, &ret_len)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ av_push(av, newSVuv(ret_len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+IV
+test_is_utf8_string_flags(char *s, STRLEN len, U32 flags)
+ CODE:
+ RETVAL = is_utf8_string_flags((U8 *) s, len, flags);
+ OUTPUT:
+ RETVAL
+
+AV *
+test_is_utf8_string_loc_flags(char *s, STRLEN len, U32 flags)
+ PREINIT:
+ AV *av;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_utf8_string_loc_flags((U8 *) s, len, &ep, flags)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_is_utf8_string_loclen_flags(char *s, STRLEN len, U32 flags)
+ PREINIT:
+ AV *av;
+ STRLEN ret_len;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_utf8_string_loclen_flags((U8 *) s, len, &ep, &ret_len, flags)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ av_push(av, newSVuv(ret_len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+IV
+test_is_strict_utf8_string(char *s, STRLEN len)
+ CODE:
+ RETVAL = is_strict_utf8_string((U8 *) s, len);
+ OUTPUT:
+ RETVAL
+
+AV *
+test_is_strict_utf8_string_loc(char *s, STRLEN len)
+ PREINIT:
+ AV *av;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_strict_utf8_string_loc((U8 *) s, len, &ep)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_is_strict_utf8_string_loclen(char *s, STRLEN len)
+ PREINIT:
+ AV *av;
+ STRLEN ret_len;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_strict_utf8_string_loclen((U8 *) s, len, &ep, &ret_len)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ av_push(av, newSVuv(ret_len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+IV
+test_is_c9strict_utf8_string(char *s, STRLEN len)
+ CODE:
+ RETVAL = is_c9strict_utf8_string((U8 *) s, len);
+ OUTPUT:
+ RETVAL
+
+AV *
+test_is_c9strict_utf8_string_loc(char *s, STRLEN len)
+ PREINIT:
+ AV *av;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_c9strict_utf8_string_loc((U8 *) s, len, &ep)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_is_c9strict_utf8_string_loclen(char *s, STRLEN len)
+ PREINIT:
+ AV *av;
+ STRLEN ret_len;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_c9strict_utf8_string_loclen((U8 *) s, len, &ep, &ret_len)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ av_push(av, newSVuv(ret_len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+IV
+test_is_utf8_fixed_width_buf_flags(char *s, STRLEN len, U32 flags)
+ CODE:
+ RETVAL = is_utf8_fixed_width_buf_flags((U8 *) s, len, flags);
+ OUTPUT:
+ RETVAL
+
+AV *
+test_is_utf8_fixed_width_buf_loc_flags(char *s, STRLEN len, U32 flags)
+ PREINIT:
+ AV *av;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_utf8_fixed_width_buf_loc_flags((U8 *) s, len, &ep, flags)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_is_utf8_fixed_width_buf_loclen_flags(char *s, STRLEN len, U32 flags)
+ PREINIT:
+ AV *av;
+ STRLEN ret_len;
+ const U8 * ep;
+ CODE:
+ av = newAV();
+ av_push(av, newSViv(is_utf8_fixed_width_buf_loclen_flags((U8 *) s, len, &ep, &ret_len, flags)));
+ av_push(av, newSViv(ep - (U8 *) s));
+ av_push(av, newSVuv(ret_len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+IV
+test_utf8_hop_safe(SV *s_sv, STRLEN s_off, IV off)
+ PREINIT:
+ STRLEN len;
+ U8 *p;
+ U8 *r;
+ CODE:
+ p = (U8 *)SvPV(s_sv, len);
+ r = utf8_hop_safe(p + s_off, off, p, p + len);
+ RETVAL = r - p;
+ OUTPUT:
+ RETVAL
+
+UV
+test_toLOWER(UV ord)
+ CODE:
+ RETVAL = toLOWER(ord);
+ OUTPUT:
+ RETVAL
+
+UV
+test_toLOWER_L1(UV ord)
+ CODE:
+ RETVAL = toLOWER_L1(ord);
+ OUTPUT:
+ RETVAL
+
+UV
+test_toLOWER_LC(UV ord)
+ CODE:
+ RETVAL = toLOWER_LC(ord);
+ OUTPUT:
+ RETVAL
+
+AV *
+test_toLOWER_uni(UV ord)
+ PREINIT:
+ U8 s[UTF8_MAXBYTES_CASE + 1];
+ STRLEN len;
+ AV *av;
+ SV *utf8;
+ CODE:
+ av = newAV();
+ av_push(av, newSVuv(toLOWER_uni(ord, s, &len)));
+
+ utf8 = newSVpvn((char *) s, len);
+ SvUTF8_on(utf8);
+ av_push(av, utf8);
+
+ av_push(av, newSVuv(len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_toLOWER_uvchr(UV ord)
+ PREINIT:
+ U8 s[UTF8_MAXBYTES_CASE + 1];
+ STRLEN len;
+ AV *av;
+ SV *utf8;
+ CODE:
+ av = newAV();
+ av_push(av, newSVuv(toLOWER_uvchr(ord, s, &len)));
+
+ utf8 = newSVpvn((char *) s, len);
+ SvUTF8_on(utf8);
+ av_push(av, utf8);
+
+ av_push(av, newSVuv(len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_toLOWER_utf8(SV * p, int type)
+ PREINIT:
+ U8 *input;
+ U8 s[UTF8_MAXBYTES_CASE + 1];
+ STRLEN len;
+ AV *av;
+ SV *utf8;
+ const unsigned char * e;
+ UV resultant_cp = UV_MAX; /* Initialized because of dumb compilers */
+ CODE:
+ input = (U8 *) SvPV(p, len);
+ av = newAV();
+ if (type >= 0) {
+ e = input + UTF8SKIP(input) - type;
+ resultant_cp = toLOWER_utf8_safe(input, e, s, &len);
+ }
+ else if (type == -1) {
+ resultant_cp = toLOWER_utf8(input, s, &len);
+ }
+#ifndef NO_MATHOMS
+ else {
+ resultant_cp = Perl_to_utf8_lower(aTHX_ input, s, &len);
+ }
+#endif
+ av_push(av, newSVuv(resultant_cp));
+
+ utf8 = newSVpvn((char *) s, len);
+ SvUTF8_on(utf8);
+ av_push(av, utf8);
+
+ av_push(av, newSVuv(len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+UV
+test_toFOLD(UV ord)
+ CODE:
+ RETVAL = toFOLD(ord);
+ OUTPUT:
+ RETVAL
+
+UV
+test_toFOLD_LC(UV ord)
+ CODE:
+ RETVAL = toFOLD_LC(ord);
+ OUTPUT:
+ RETVAL
+
+AV *
+test_toFOLD_uni(UV ord)
+ PREINIT:
+ U8 s[UTF8_MAXBYTES_CASE + 1];
+ STRLEN len;
AV *av;
SV *utf8;
CODE:
RETVAL
AV *
-test_toFOLD_utf8(SV * p)
+test_toFOLD_uvchr(UV ord)
+ PREINIT:
+ U8 s[UTF8_MAXBYTES_CASE + 1];
+ STRLEN len;
+ AV *av;
+ SV *utf8;
+ CODE:
+ av = newAV();
+ av_push(av, newSVuv(toFOLD_uvchr(ord, s, &len)));
+
+ utf8 = newSVpvn((char *) s, len);
+ SvUTF8_on(utf8);
+ av_push(av, utf8);
+
+ av_push(av, newSVuv(len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_toFOLD_utf8(SV * p, int type)
PREINIT:
U8 *input;
U8 s[UTF8_MAXBYTES_CASE + 1];
STRLEN len;
AV *av;
SV *utf8;
+ const unsigned char * e;
+ UV resultant_cp = UV_MAX;
CODE:
input = (U8 *) SvPV(p, len);
av = newAV();
- av_push(av, newSVuv(toFOLD_utf8(input, s, &len)));
+ if (type >= 0) {
+ e = input + UTF8SKIP(input) - type;
+ resultant_cp = toFOLD_utf8_safe(input, e, s, &len);
+ }
+ else if (type == -1) {
+ resultant_cp = toFOLD_utf8(input, s, &len);
+ }
+#ifndef NO_MATHOMS
+ else {
+ resultant_cp = Perl_to_utf8_fold(aTHX_ input, s, &len);
+ }
+#endif
+ av_push(av, newSVuv(resultant_cp));
utf8 = newSVpvn((char *) s, len);
SvUTF8_on(utf8);
RETVAL
AV *
-test_toUPPER_utf8(SV * p)
+test_toUPPER_uvchr(UV ord)
+ PREINIT:
+ U8 s[UTF8_MAXBYTES_CASE + 1];
+ STRLEN len;
+ AV *av;
+ SV *utf8;
+ CODE:
+ av = newAV();
+ av_push(av, newSVuv(toUPPER_uvchr(ord, s, &len)));
+
+ utf8 = newSVpvn((char *) s, len);
+ SvUTF8_on(utf8);
+ av_push(av, utf8);
+
+ av_push(av, newSVuv(len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_toUPPER_utf8(SV * p, int type)
PREINIT:
U8 *input;
U8 s[UTF8_MAXBYTES_CASE + 1];
STRLEN len;
AV *av;
SV *utf8;
+ const unsigned char * e;
+ UV resultant_cp = UV_MAX;
CODE:
input = (U8 *) SvPV(p, len);
av = newAV();
- av_push(av, newSVuv(toUPPER_utf8(input, s, &len)));
+ if (type >= 0) {
+ e = input + UTF8SKIP(input) - type;
+ resultant_cp = toUPPER_utf8_safe(input, e, s, &len);
+ }
+ else if (type == -1) {
+ resultant_cp = toUPPER_utf8(input, s, &len);
+ }
+#ifndef NO_MATHOMS
+ else {
+ resultant_cp = Perl_to_utf8_upper(aTHX_ input, s, &len);
+ }
+#endif
+ av_push(av, newSVuv(resultant_cp));
utf8 = newSVpvn((char *) s, len);
SvUTF8_on(utf8);
RETVAL
AV *
-test_toTITLE_utf8(SV * p)
+test_toTITLE_uvchr(UV ord)
+ PREINIT:
+ U8 s[UTF8_MAXBYTES_CASE + 1];
+ STRLEN len;
+ AV *av;
+ SV *utf8;
+ CODE:
+ av = newAV();
+ av_push(av, newSVuv(toTITLE_uvchr(ord, s, &len)));
+
+ utf8 = newSVpvn((char *) s, len);
+ SvUTF8_on(utf8);
+ av_push(av, utf8);
+
+ av_push(av, newSVuv(len));
+ RETVAL = av;
+ OUTPUT:
+ RETVAL
+
+AV *
+test_toTITLE_utf8(SV * p, int type)
PREINIT:
U8 *input;
U8 s[UTF8_MAXBYTES_CASE + 1];
STRLEN len;
AV *av;
SV *utf8;
+ const unsigned char * e;
+ UV resultant_cp = UV_MAX;
CODE:
input = (U8 *) SvPV(p, len);
av = newAV();
- av_push(av, newSVuv(toTITLE_utf8(input, s, &len)));
+ if (type >= 0) {
+ e = input + UTF8SKIP(input) - type;
+ resultant_cp = toTITLE_utf8_safe(input, e, s, &len);
+ }
+ else if (type == -1) {
+ resultant_cp = toTITLE_utf8(input, s, &len);
+ }
+#ifndef NO_MATHOMS
+ else {
+ resultant_cp = Perl_to_utf8_title(aTHX_ input, s, &len);
+ }
+#endif
+ av_push(av, newSVuv(resultant_cp));
utf8 = newSVpvn((char *) s, len);
SvUTF8_on(utf8);
CODE:
len = (int) SvIV(num_digits);
if (len > 99) croak("Too long a number for test_Gconvert");
+ if (len < 0) croak("Too short a number for test_Gconvert");
PERL_UNUSED_RESULT(Gconvert(SvNV(number), len,
0, /* No trailing zeroes */
buffer));
RETVAL = newSVpv(buffer, 0);
OUTPUT:
RETVAL
+
+SV *
+test_Perl_langinfo(SV * item)
+ CODE:
+ RETVAL = newSVpv(Perl_langinfo(SvIV(item)), 0);
+ OUTPUT:
+ RETVAL
+
+MODULE = XS::APItest PACKAGE = XS::APItest::Backrefs
+
+void
+apitest_weaken(SV *sv)
+ PROTOTYPE: $
+ CODE:
+ sv_rvweaken(sv);
+
+SV *
+has_backrefs(SV *sv)
+ CODE:
+ if (SvROK(sv) && sv_get_backrefs(SvRV(sv)))
+ RETVAL = &PL_sv_yes;
+ else
+ RETVAL = &PL_sv_no;
+ OUTPUT:
+ RETVAL
+
+#ifdef WIN32
+#ifdef PERL_IMPLICIT_SYS
+
+const char *
+PerlDir_mapA(const char *path)
+
+const WCHAR *
+PerlDir_mapW(const WCHAR *wpath)
+
+#endif
+
+void
+Comctl32Version()
+ PREINIT:
+ HMODULE dll;
+ VS_FIXEDFILEINFO *info;
+ UINT len;
+ HRSRC hrsc;
+ HGLOBAL ver;
+ void * vercopy;
+ PPCODE:
+ dll = GetModuleHandle("comctl32.dll"); /* must already be in proc */
+ if(!dll)
+ croak("Comctl32Version: comctl32.dll not in process???");
+ hrsc = FindResource(dll, MAKEINTRESOURCE(VS_VERSION_INFO),
+ MAKEINTRESOURCE(VS_FILE_INFO));
+ if(!hrsc)
+ croak("Comctl32Version: comctl32.dll no version???");
+ ver = LoadResource(dll, hrsc);
+ len = SizeofResource(dll, hrsc);
+ vercopy = _alloca(len);
+ memcpy(vercopy, ver, len);
+ if (VerQueryValue(vercopy, "\\", (void**)&info, &len)) {
+ int dwValueMS1 = (info->dwFileVersionMS>>16);
+ int dwValueMS2 = (info->dwFileVersionMS&0xffff);
+ int dwValueLS1 = (info->dwFileVersionLS>>16);
+ int dwValueLS2 = (info->dwFileVersionLS&0xffff);
+ EXTEND(SP, 4);
+ mPUSHi(dwValueMS1);
+ mPUSHi(dwValueMS2);
+ mPUSHi(dwValueLS1);
+ mPUSHi(dwValueLS2);
+ }
+
+#endif
+
+
https://perl5.git.perl.org / perl5.git / blobdiff