This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
rename convert to op_convert_list and APIfy
[perl5.git] / ext / XS-APItest / APItest.xs
index b23232c..c5ae2be 100644 (file)
@@ -2,6 +2,7 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#include "fakesdio.h"   /* Causes us to use PerlIO below */
 
 typedef SV *SVREF;
 typedef PTR_TBL_t *XS__APItest__PtrTable;
 
 typedef SV *SVREF;
 typedef PTR_TBL_t *XS__APItest__PtrTable;
@@ -82,7 +83,6 @@ typedef void (freeent_function)(pTHX_ HV *, HE *);
 
 void
 test_freeent(freeent_function *f) {
 
 void
 test_freeent(freeent_function *f) {
-    dTHX;
     dSP;
     HV *test_hash = newHV();
     HE *victim;
     dSP;
     HV *test_hash = newHV();
     HE *victim;
@@ -148,8 +148,8 @@ bitflip_key(pTHX_ IV action, SV *field) {
                const char *const end = p + len;
                while (p < end) {
                    STRLEN len;
                const char *const end = p + len;
                while (p < end) {
                    STRLEN len;
-                   UV chr = utf8_to_uvuni_buf((U8 *)p, (U8 *) end, &len);
-                   new_p = (char *)uvuni_to_utf8((U8 *)new_p, chr ^ 32);
+                   UV chr = utf8_to_uvchr_buf((U8 *)p, (U8 *) end, &len);
+                   new_p = (char *)uvchr_to_utf8((U8 *)new_p, chr ^ 32);
                    p += len;
                }
                SvUTF8_on(newkey);
                    p += len;
                }
                SvUTF8_on(newkey);
@@ -274,7 +274,7 @@ blockhook_csc_start(pTHX_ int full)
         I32 i;
         AV *const new_av = newAV();
 
         I32 i;
         AV *const new_av = newAV();
 
-        for (i = 0; i <= av_len(cur); i++) {
+        for (i = 0; i <= av_tindex(cur); i++) {
             av_store(new_av, i, newSVsv(*av_fetch(cur, i, 0)));
         }
 
             av_store(new_av, i, newSVsv(*av_fetch(cur, i, 0)));
         }
 
@@ -400,9 +400,9 @@ THX_ck_entersub_args_scalars(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
     OP *aop = cUNOPx(entersubop)->op_first;
     PERL_UNUSED_ARG(namegv);
     PERL_UNUSED_ARG(ckobj);
     OP *aop = cUNOPx(entersubop)->op_first;
     PERL_UNUSED_ARG(namegv);
     PERL_UNUSED_ARG(ckobj);
-    if (!aop->op_sibling)
+    if (!OP_HAS_SIBLING(aop))
        aop = cUNOPx(aop)->op_first;
        aop = cUNOPx(aop)->op_first;
-    for (aop = aop->op_sibling; aop->op_sibling; aop = aop->op_sibling) {
+    for (aop = OP_SIBLING(aop); OP_HAS_SIBLING(aop); aop = OP_SIBLING(aop)) {
        op_contextualize(aop, G_SCALAR);
     }
     return entersubop;
        op_contextualize(aop, G_SCALAR);
     }
     return entersubop;
@@ -412,17 +412,20 @@ STATIC OP *
 THX_ck_entersub_multi_sum(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 {
     OP *sumop = NULL;
 THX_ck_entersub_multi_sum(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 {
     OP *sumop = NULL;
+    OP *parent = entersubop;
     OP *pushop = cUNOPx(entersubop)->op_first;
     PERL_UNUSED_ARG(namegv);
     PERL_UNUSED_ARG(ckobj);
     OP *pushop = cUNOPx(entersubop)->op_first;
     PERL_UNUSED_ARG(namegv);
     PERL_UNUSED_ARG(ckobj);
-    if (!pushop->op_sibling)
+    if (!OP_HAS_SIBLING(pushop)) {
+        parent = pushop;
        pushop = cUNOPx(pushop)->op_first;
        pushop = cUNOPx(pushop)->op_first;
+    }
     while (1) {
     while (1) {
-       OP *aop = pushop->op_sibling;
-       if (!aop->op_sibling)
+       OP *aop = OP_SIBLING(pushop);
+       if (!OP_HAS_SIBLING(aop))
            break;
            break;
-       pushop->op_sibling = aop->op_sibling;
-       aop->op_sibling = NULL;
+        /* cut out first arg */
+        op_sibling_splice(parent, pushop, 1, NULL);
        op_contextualize(aop, G_SCALAR);
        if (sumop) {
            sumop = newBINOP(OP_ADD, 0, sumop, aop);
        op_contextualize(aop, G_SCALAR);
        if (sumop) {
            sumop = newBINOP(OP_ADD, 0, sumop, aop);
@@ -449,7 +452,7 @@ test_op_list_describe_part(SV *res, OP *o)
     if (o->op_flags & OPf_KIDS) {
        OP *k;
        sv_catpvs(res, "[");
     if (o->op_flags & OPf_KIDS) {
        OP *k;
        sv_catpvs(res, "[");
-       for (k = cUNOPx(o)->op_first; k; k = k->op_sibling)
+       for (k = cUNOPx(o)->op_first; k; k = OP_SIBLING(k))
            test_op_list_describe_part(res, k);
        sv_catpvs(res, "]");
     } else {
            test_op_list_describe_part(res, k);
        sv_catpvs(res, "]");
     } else {
@@ -476,8 +479,7 @@ THX_mkUNOP(pTHX_ U32 type, OP *first)
     UNOP *unop;
     NewOp(1103, unop, 1, UNOP);
     unop->op_type   = (OPCODE)type;
     UNOP *unop;
     NewOp(1103, unop, 1, UNOP);
     unop->op_type   = (OPCODE)type;
-    unop->op_first  = first;
-    unop->op_flags  = OPf_KIDS;
+    op_sibling_splice((OP*)unop, NULL, 0, first);
     return (OP *)unop;
 }
 
     return (OP *)unop;
 }
 
@@ -488,10 +490,8 @@ THX_mkBINOP(pTHX_ U32 type, OP *first, OP *last)
     BINOP *binop;
     NewOp(1103, binop, 1, BINOP);
     binop->op_type      = (OPCODE)type;
     BINOP *binop;
     NewOp(1103, binop, 1, BINOP);
     binop->op_type      = (OPCODE)type;
-    binop->op_first     = first;
-    binop->op_flags     = OPf_KIDS;
-    binop->op_last      = last;
-    first->op_sibling   = last;
+    op_sibling_splice((OP*)binop, NULL, 0, last);
+    op_sibling_splice((OP*)binop, NULL, 0, first);
     return (OP *)binop;
 }
 
     return (OP *)binop;
 }
 
@@ -502,11 +502,9 @@ THX_mkLISTOP(pTHX_ U32 type, OP *first, OP *sib, OP *last)
     LISTOP *listop;
     NewOp(1103, listop, 1, LISTOP);
     listop->op_type     = (OPCODE)type;
     LISTOP *listop;
     NewOp(1103, listop, 1, LISTOP);
     listop->op_type     = (OPCODE)type;
-    listop->op_flags    = OPf_KIDS;
-    listop->op_first    = first;
-    first->op_sibling   = sib;
-    sib->op_sibling     = last;
-    listop->op_last     = last;
+    op_sibling_splice((OP*)listop, NULL, 0, last);
+    op_sibling_splice((OP*)listop, NULL, 0, sib);
+    op_sibling_splice((OP*)listop, NULL, 0, first);
     return (OP *)listop;
 }
 
     return (OP *)listop;
 }
 
@@ -532,12 +530,14 @@ STATIC void
 THX_run_cleanup(pTHX_ void *cleanup_code_ref)
 {
     dSP;
 THX_run_cleanup(pTHX_ void *cleanup_code_ref)
 {
     dSP;
+    PUSHSTACK;
     ENTER;
     SAVETMPS;
     PUSHMARK(SP);
     call_sv((SV*)cleanup_code_ref, G_VOID|G_DISCARD);
     FREETMPS;
     LEAVE;
     ENTER;
     SAVETMPS;
     PUSHMARK(SP);
     call_sv((SV*)cleanup_code_ref, G_VOID|G_DISCARD);
     FREETMPS;
     LEAVE;
+    POPSTACK;
 }
 
 STATIC OP *
 }
 
 STATIC OP *
@@ -555,19 +555,21 @@ THX_pp_establish_cleanup(pTHX)
 STATIC OP *
 THX_ck_entersub_establish_cleanup(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 {
 STATIC OP *
 THX_ck_entersub_establish_cleanup(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 {
-    OP *pushop, *argop, *estop;
+    OP *parent, *pushop, *argop, *estop;
     ck_entersub_args_proto(entersubop, namegv, ckobj);
     ck_entersub_args_proto(entersubop, namegv, ckobj);
+    parent = entersubop;
     pushop = cUNOPx(entersubop)->op_first;
     pushop = cUNOPx(entersubop)->op_first;
-    if(!pushop->op_sibling) pushop = cUNOPx(pushop)->op_first;
-    argop = pushop->op_sibling;
-    pushop->op_sibling = argop->op_sibling;
-    argop->op_sibling = NULL;
+    if(!OP_HAS_SIBLING(pushop)) {
+        parent = pushop;
+        pushop = cUNOPx(pushop)->op_first;
+    }
+    /* extract out first arg, then delete the rest of the tree */
+    argop = OP_SIBLING(pushop);
+    op_sibling_splice(parent, pushop, 1, NULL);
     op_free(entersubop);
     op_free(entersubop);
-    NewOpSz(0, estop, sizeof(UNOP));
-    estop->op_type = OP_RAND;
+
+    estop = mkUNOP(OP_RAND, argop);
     estop->op_ppaddr = THX_pp_establish_cleanup;
     estop->op_ppaddr = THX_pp_establish_cleanup;
-    cUNOPx(estop)->op_flags = OPf_KIDS;
-    cUNOPx(estop)->op_first = argop;
     PL_hints |= HINT_BLOCK_SCOPE;
     return estop;
 }
     PL_hints |= HINT_BLOCK_SCOPE;
     return estop;
 }
@@ -575,13 +577,16 @@ THX_ck_entersub_establish_cleanup(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 STATIC OP *
 THX_ck_entersub_postinc(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 {
 STATIC OP *
 THX_ck_entersub_postinc(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 {
-    OP *pushop, *argop;
+    OP *parent, *pushop, *argop;
     ck_entersub_args_proto(entersubop, namegv, ckobj);
     ck_entersub_args_proto(entersubop, namegv, ckobj);
+    parent = entersubop;
     pushop = cUNOPx(entersubop)->op_first;
     pushop = cUNOPx(entersubop)->op_first;
-    if(!pushop->op_sibling) pushop = cUNOPx(pushop)->op_first;
-    argop = pushop->op_sibling;
-    pushop->op_sibling = argop->op_sibling;
-    argop->op_sibling = NULL;
+    if(!OP_HAS_SIBLING(pushop)) {
+        parent = pushop;
+        pushop = cUNOPx(pushop)->op_first;
+    }
+    argop = OP_SIBLING(pushop);
+    op_sibling_splice(parent, pushop, 1, NULL);
     op_free(entersubop);
     return newUNOP(OP_POSTINC, 0,
        op_lvalue(op_contextualize(argop, G_SCALAR), OP_POSTINC));
     op_free(entersubop);
     return newUNOP(OP_POSTINC, 0,
        op_lvalue(op_contextualize(argop, G_SCALAR), OP_POSTINC));
@@ -595,12 +600,13 @@ THX_ck_entersub_pad_scalar(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
     SV *a0, *a1;
     ck_entersub_args_proto(entersubop, namegv, ckobj);
     pushop = cUNOPx(entersubop)->op_first;
     SV *a0, *a1;
     ck_entersub_args_proto(entersubop, namegv, ckobj);
     pushop = cUNOPx(entersubop)->op_first;
-    if(!pushop->op_sibling) pushop = cUNOPx(pushop)->op_first;
-    argop = pushop->op_sibling;
-    if(argop->op_type != OP_CONST || argop->op_sibling->op_type != OP_CONST)
+    if(!OP_HAS_SIBLING(pushop))
+        pushop = cUNOPx(pushop)->op_first;
+    argop = OP_SIBLING(pushop);
+    if(argop->op_type != OP_CONST || OP_SIBLING(argop)->op_type != OP_CONST)
        croak("bad argument expression type for pad_scalar()");
     a0 = cSVOPx_sv(argop);
        croak("bad argument expression type for pad_scalar()");
     a0 = cSVOPx_sv(argop);
-    a1 = cSVOPx_sv(argop->op_sibling);
+    a1 = cSVOPx_sv(OP_SIBLING(argop));
     switch(SvIV(a0)) {
        case 1: {
            SV *namesv = sv_2mortal(newSVpvs("$"));
     switch(SvIV(a0)) {
        case 1: {
            SV *namesv = sv_2mortal(newSVpvs("$"));
@@ -656,6 +662,9 @@ static SV *hintkey_swaplabel_sv, *hintkey_labelconst_sv;
 static SV *hintkey_arrayfullexpr_sv, *hintkey_arraylistexpr_sv;
 static SV *hintkey_arraytermexpr_sv, *hintkey_arrayarithexpr_sv;
 static SV *hintkey_arrayexprflags_sv;
 static SV *hintkey_arrayfullexpr_sv, *hintkey_arraylistexpr_sv;
 static SV *hintkey_arraytermexpr_sv, *hintkey_arrayarithexpr_sv;
 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 */
 static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
 
 /* low-level parser helpers */
@@ -688,16 +697,18 @@ static OP *THX_parse_var(pTHX)
 }
 
 #define push_rpn_item(o) \
 }
 
 #define push_rpn_item(o) \
-    (tmpop = (o), tmpop->op_sibling = stack, stack = tmpop)
-#define pop_rpn_item() \
-    (!stack ? (croak("RPN stack underflow"), (OP*)NULL) : \
-     (tmpop = stack, stack = stack->op_sibling, \
-      tmpop->op_sibling = NULL, tmpop))
+    op_sibling_splice(parent, NULL, 0, o);
+#define pop_rpn_item() ( \
+    (tmpop = op_sibling_splice(parent, NULL, 1, NULL)) \
+        ? tmpop : (croak("RPN stack underflow"), (OP*)NULL))
 
 #define parse_rpn_expr() THX_parse_rpn_expr(aTHX)
 static OP *THX_parse_rpn_expr(pTHX)
 {
 
 #define parse_rpn_expr() THX_parse_rpn_expr(aTHX)
 static OP *THX_parse_rpn_expr(pTHX)
 {
-    OP *stack = NULL, *tmpop;
+    OP *tmpop;
+    /* fake parent for splice to mess with */
+    OP *parent = mkBINOP(OP_NULL, NULL, NULL);
+
     while(1) {
        I32 c;
        lex_read_space(0);
     while(1) {
        I32 c;
        lex_read_space(0);
@@ -705,7 +716,9 @@ static OP *THX_parse_rpn_expr(pTHX)
        switch(c) {
            case /*(*/')': case /*{*/'}': {
                OP *result = pop_rpn_item();
        switch(c) {
            case /*(*/')': case /*{*/'}': {
                OP *result = pop_rpn_item();
-               if(stack) croak("RPN expression must return a single value");
+               if(cLISTOPx(parent)->op_first)
+                    croak("RPN expression must return a single value");
+                op_free(parent);
                return result;
            } break;
            case '0': case '1': case '2': case '3': case '4':
                return result;
            } break;
            case '0': case '1': case '2': case '3': case '4':
@@ -941,6 +954,106 @@ static OP *THX_parse_keyword_arrayexprflags(pTHX)
     return o ? newANONLIST(o) : newANONHASH(newOP(OP_STUB, 0));
 }
 
     return o ? newANONLIST(o) : newANONHASH(newOP(OP_STUB, 0));
 }
 
+#define parse_keyword_DEFSV() THX_parse_keyword_DEFSV(aTHX)
+static OP *THX_parse_keyword_DEFSV(pTHX)
+{
+    return newDEFSVOP();
+}
+
+#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) {
+        sv_utf8_upgrade(sv);
+    }
+    sv_catpvn(sv, ds, d - ds);
+}
+
+#define parse_keyword_with_vars() THX_parse_keyword_with_vars(aTHX)
+static OP *THX_parse_keyword_with_vars(pTHX)
+{
+    I32 c;
+    IV count;
+    int save_ix;
+    OP *vardeclseq, *body;
+
+    save_ix = block_start(TRUE);
+    vardeclseq = NULL;
+
+    count = 0;
+
+    lex_read_space(0);
+    c = lex_peek_unichar(0);
+    while (c != '{') {
+        SV *varname;
+        PADOFFSET padoff;
+
+        if (c == -1) {
+            croak("unexpected EOF; expecting '{'");
+        }
+
+        if (!isIDFIRST_uni(c)) {
+            croak("unexpected '%c'; expecting an identifier", (int)c);
+        }
+
+        varname = newSVpvs("$");
+        if (lex_bufutf8()) {
+            SvUTF8_on(varname);
+        }
+
+        sv_cat_c(varname, c);
+        lex_read_unichar(0);
+
+        while (c = lex_peek_unichar(0), c != -1 && isIDCONT_uni(c)) {
+            sv_cat_c(varname, c);
+            lex_read_unichar(0);
+        }
+
+        padoff = pad_add_name_sv(varname, padadd_NO_DUP_CHECK, NULL, NULL);
+
+        {
+            OP *my_var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8));
+            my_var->op_targ = padoff;
+
+            vardeclseq = op_append_list(
+                OP_LINESEQ,
+                vardeclseq,
+                newSTATEOP(
+                    0, NULL,
+                    newASSIGNOP(
+                        OPf_STACKED,
+                        my_var, 0,
+                        newSVOP(
+                            OP_CONST, 0,
+                            newSViv(++count)
+                        )
+                    )
+                )
+            );
+        }
+
+        lex_read_space(0);
+        c = lex_peek_unichar(0);
+    }
+
+    intro_my();
+
+    body = parse_block(0);
+
+    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)
 /* plugin glue */
 
 #define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv)
@@ -1025,6 +1138,18 @@ static int my_keyword_plugin(pTHX_
                    keyword_active(hintkey_arrayexprflags_sv)) {
        *op_ptr = parse_keyword_arrayexprflags();
        return KEYWORD_PLUGIN_EXPR;
                    keyword_active(hintkey_arrayexprflags_sv)) {
        *op_ptr = parse_keyword_arrayexprflags();
        return KEYWORD_PLUGIN_EXPR;
+    } else if(keyword_len == 5 && strnEQ(keyword_ptr, "DEFSV", 5) &&
+                   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) &&
+                   keyword_active(hintkey_with_vars_sv)) {
+       *op_ptr = parse_keyword_with_vars();
+       return KEYWORD_PLUGIN_STMT;
+    } else if(keyword_len == 15 && strnEQ(keyword_ptr, "join_with_space", 15) &&
+                   keyword_active(hintkey_join_with_space_sv)) {
+       *op_ptr = parse_join_with_space();
+       return KEYWORD_PLUGIN_EXPR;
     } else {
        return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
     }
     } else {
        return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
     }
@@ -1049,7 +1174,6 @@ peep_xop(pTHX_ OP *o, OP *oldop)
 static I32
 filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
 static I32
 filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
-    SV   *my_sv = FILTER_DATA(idx);
     char *p;
     char *end;
     int n = FILTER_READ(idx + 1, buf_sv, maxlen);
     char *p;
     char *end;
     int n = FILTER_READ(idx + 1, buf_sv, maxlen);
@@ -1090,14 +1214,14 @@ addissub_myck_add(pTHX_ OP *op)
     OP *aop, *bop;
     U8 flags;
     if (!(flag_svp && SvTRUE(*flag_svp) && (op->op_flags & OPf_KIDS) &&
     OP *aop, *bop;
     U8 flags;
     if (!(flag_svp && SvTRUE(*flag_svp) && (op->op_flags & OPf_KIDS) &&
-           (aop = cBINOPx(op)->op_first) && (bop = aop->op_sibling) &&
-           !bop->op_sibling))
+           (aop = cBINOPx(op)->op_first) && (bop = OP_SIBLING(aop)) &&
+           !OP_HAS_SIBLING(bop)))
        return addissub_nxck_add(aTHX_ op);
        return addissub_nxck_add(aTHX_ op);
-    aop->op_sibling = NULL;
-    cBINOPx(op)->op_first = NULL;
-    op->op_flags &= ~OPf_KIDS;
     flags = op->op_flags;
     flags = op->op_flags;
-    op_free(op);
+    op_sibling_splice(op, NULL, 1, NULL); /* excise aop */
+    op_sibling_splice(op, NULL, 1, NULL); /* excise bop */
+    op_free(op); /* free the empty husk */
+    flags &= ~OPf_KIDS;
     return newBINOP(OP_SUBTRACT, flags, aop, bop);
 }
 
     return newBINOP(OP_SUBTRACT, flags, aop, bop);
 }
 
@@ -1151,7 +1275,7 @@ bytes_cmp_utf8(bytes, utf8)
        RETVAL
 
 AV *
        RETVAL
 
 AV *
-test_utf8n_to_uvuni(s, len, flags)
+test_utf8n_to_uvchr(s, len, flags)
 
         SV *s
         SV *len
 
         SV *s
         SV *len
@@ -1162,7 +1286,7 @@ test_utf8n_to_uvuni(s, len, flags)
         STRLEN slen;
 
     CODE:
         STRLEN slen;
 
     CODE:
-        /* Call utf8n_to_uvuni() with the inputs.  It always asks for the
+        /* Call utf8n_to_uvchr() with the inputs.  It always asks for the
          * actual length to be returned
          *
          * Length to assume <s> is; not checked, so could have buffer overflow
          * actual length to be returned
          *
          * Length to assume <s> is; not checked, so could have buffer overflow
@@ -1171,7 +1295,7 @@ test_utf8n_to_uvuni(s, len, flags)
         sv_2mortal((SV*)RETVAL);
 
         ret
         sv_2mortal((SV*)RETVAL);
 
         ret
-         = utf8n_to_uvuni((U8*) SvPV(s, slen), SvUV(len), &retlen, SvUV(flags));
+         = utf8n_to_uvchr((U8*) SvPV(s, slen), SvUV(len), &retlen, SvUV(flags));
 
         /* Returns the return value in [0]; <retlen> in [1] */
         av_push(RETVAL, newSVuv(ret));
 
         /* Returns the return value in [0]; <retlen> in [1] */
         av_push(RETVAL, newSVuv(ret));
@@ -1455,13 +1579,17 @@ common(params)
        if ((svp = hv_fetchs(params, "hash", 0)))
            hash = SvUV(*svp);
 
        if ((svp = hv_fetchs(params, "hash", 0)))
            hash = SvUV(*svp);
 
-       if ((svp = hv_fetchs(params, "hash_pv", 0))) {
+       if (hv_fetchs(params, "hash_pv", 0)) {
+            assert(key);
            PERL_HASH(hash, key, klen);
        }
            PERL_HASH(hash, key, klen);
        }
-       if ((svp = hv_fetchs(params, "hash_sv", 0))) {
-           STRLEN len;
-           const char *const p = SvPV(keysv, len);
-           PERL_HASH(hash, p, len);
+       if (hv_fetchs(params, "hash_sv", 0)) {
+            assert(keysv);
+            {
+              STRLEN len;
+              const char *const p = SvPV(keysv, len);
+              PERL_HASH(hash, p, len);
+            }
        }
 
        result = (HE *)hv_common(hv, keysv, key, klen, flags, action, val, hash);
        }
 
        result = (HE *)hv_common(hv, keysv, key, klen, flags, action, val, hash);
@@ -1534,6 +1662,22 @@ refcounted_he_fetch(key, level=0)
 
 #endif
 
 
 #endif
 
+void
+test_force_keys(HV *hv)
+    PREINIT:
+        HE *he;
+       STRLEN count = 0;
+    PPCODE:
+        hv_iterinit(hv);
+        he = hv_iternext(hv);
+        while (he) {
+           SV *sv = HeSVKEY_force(he);
+           ++count;
+           EXTEND(SP, count);
+           PUSHs(sv_mortalcopy(sv));
+            he = hv_iternext(hv);
+        }
+
 =pod
 
 sub TIEHASH  { bless {}, $_[0] }
 =pod
 
 sub TIEHASH  { bless {}, $_[0] }
@@ -1621,6 +1765,7 @@ SV *
 AUTOLOADp(...)
     PROTOTYPE: *$
     CODE:
 AUTOLOADp(...)
     PROTOTYPE: *$
     CODE:
+        PERL_UNUSED_ARG(items);
        RETVAL = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SvUTF8(cv));
     OUTPUT:
        RETVAL
        RETVAL = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SvUTF8(cv));
     OUTPUT:
        RETVAL
@@ -1710,12 +1855,9 @@ xop_build_optree ()
 
         kid = newSVOP(OP_CONST, 0, newSViv(42));
         
 
         kid = newSVOP(OP_CONST, 0, newSViv(42));
         
-        NewOp(1102, unop, 1, UNOP);
-        unop->op_type       = OP_CUSTOM;
+        unop = (UNOP*)mkUNOP(OP_CUSTOM, kid);
         unop->op_ppaddr     = pp_xop;
         unop->op_ppaddr     = pp_xop;
-        unop->op_flags      = OPf_KIDS;
         unop->op_private    = 0;
         unop->op_private    = 0;
-        unop->op_first      = kid;
         unop->op_next       = NULL;
         kid->op_next        = (OP*)unop;
 
         unop->op_next       = NULL;
         kid->op_next        = (OP*)unop;
 
@@ -1736,6 +1878,25 @@ xop_build_optree ()
     OUTPUT:
         RETVAL
 
     OUTPUT:
         RETVAL
 
+IV
+xop_from_custom_op ()
+    CODE:
+/* author note: this test doesn't imply Perl_custom_op_xop is or isn't public
+   API or that Perl_custom_op_xop is known to be used outside the core */
+        UNOP *unop;
+        XOP *xop;
+
+        unop = (UNOP*)mkUNOP(OP_CUSTOM, NULL);
+        unop->op_ppaddr     = pp_xop;
+        unop->op_private    = 0;
+        unop->op_next       = NULL;
+
+        xop = Perl_custom_op_xop(aTHX_ (OP *)unop);
+        FreeOp(unop);
+        RETVAL = PTR2IV(xop);
+    OUTPUT:
+        RETVAL
+
 BOOT:
 {
     MY_CXT_INIT;
 BOOT:
 {
     MY_CXT_INIT;
@@ -1904,6 +2065,81 @@ mxpushu()
        mXPUSHu(3);
        XSRETURN(3);
 
        mXPUSHu(3);
        XSRETURN(3);
 
+void
+call_sv_C()
+PREINIT:
+    CV * i_sub;
+    GV * i_gv;
+    I32 retcnt;
+    SV * errsv;
+    char * errstr;
+    SV * miscsv = sv_newmortal();
+    HV * hv = (HV*)sv_2mortal((SV*)newHV());
+CODE:
+    i_sub = get_cv("i", 0);
+    PUSHMARK(SP);
+    /* PUTBACK not needed since this sub was called with 0 args, and is calling
+      0 args, so global SP doesn't need to be moved before a call_* */
+    retcnt = call_sv((SV*)i_sub, 0); /* try a CV* */
+    SPAGAIN;
+    SP -= retcnt; /* dont care about return count, wipe everything off */
+    sv_setpvs(miscsv, "i");
+    PUSHMARK(SP);
+    retcnt = call_sv(miscsv, 0); /* try a PV */
+    SPAGAIN;
+    SP -= retcnt;
+    /* no add and SVt_NULL are intentional, sub i should be defined already */
+    i_gv = gv_fetchpvn_flags("i", sizeof("i")-1, 0, SVt_NULL);
+    PUSHMARK(SP);
+    retcnt = call_sv((SV*)i_gv, 0); /* try a GV* */
+    SPAGAIN;
+    SP -= retcnt;
+    /* the tests below are not declaring this being public API behavior,
+       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 */
+    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)) {
+        PUSHMARK(SP);
+        retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
+        SPAGAIN;
+        SP -= retcnt;
+    }
+    PUSHMARK(SP);
+    retcnt = call_sv(&PL_sv_undef,  G_EVAL);
+    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)) {
+        PUSHMARK(SP);
+        retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
+        SPAGAIN;
+        SP -= retcnt;
+    }
+    PUSHMARK(SP);
+    retcnt = call_sv((SV*)hv,  G_EVAL);
+    SPAGAIN;
+    SP -= retcnt;
+    errsv = ERRSV;
+    errstr = SvPV_nolen(errsv);
+    if(strnEQ(errstr, "Not a CODE reference at",
+              sizeof("Not a CODE reference at") - 1)) {
+        PUSHMARK(SP);
+        retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
+        SPAGAIN;
+        SP -= retcnt;
+    }
 
 void
 call_sv(sv, flags, ...)
 
 void
 call_sv(sv, flags, ...)
@@ -1965,7 +2201,7 @@ newCONSTSUB(stash, name, flags, sv)
     ALIAS:
        newCONSTSUB_flags = 1
     PREINIT:
     ALIAS:
        newCONSTSUB_flags = 1
     PREINIT:
-       CV* mycv;
+       CV* mycv = NULL;
        STRLEN len;
        const char *pv = SvPV(name, len);
     PPCODE:
        STRLEN len;
        const char *pv = SvPV(name, len);
     PPCODE:
@@ -1980,6 +2216,7 @@ newCONSTSUB(stash, name, flags, sv)
                break;
         }
         EXTEND(SP, 2);
                break;
         }
         EXTEND(SP, 2);
+        assert(mycv);
         PUSHs( CvCONST(mycv) ? &PL_sv_yes : &PL_sv_no );
         PUSHs((SV*)CvGV(mycv));
 
         PUSHs( CvCONST(mycv) ? &PL_sv_yes : &PL_sv_no );
         PUSHs((SV*)CvGV(mycv));
 
@@ -2023,7 +2260,7 @@ gv_fetchmeth_type(stash, methname, type, level, flags)
     PREINIT:
         STRLEN len;
         const char * const name = SvPV_const(methname, len);
     PREINIT:
         STRLEN len;
         const char * const name = SvPV_const(methname, len);
-       GV* gv;
+       GV* gv = NULL;
     PPCODE:
         switch (type) {
            case 0:
     PPCODE:
         switch (type) {
            case 0:
@@ -2051,7 +2288,7 @@ gv_fetchmeth_autoload_type(stash, methname, type, level, flags)
     PREINIT:
         STRLEN len;
         const char * const name = SvPV_const(methname, len);
     PREINIT:
         STRLEN len;
         const char * const name = SvPV_const(methname, len);
-       GV* gv;
+       GV* gv = NULL;
     PPCODE:
         switch (type) {
            case 0:
     PPCODE:
         switch (type) {
            case 0:
@@ -2076,7 +2313,7 @@ gv_fetchmethod_flags_type(stash, methname, type, flags)
     int type
     I32 flags
     PREINIT:
     int type
     I32 flags
     PREINIT:
-       GV* gv;
+       GV* gv = NULL;
     PPCODE:
         switch (type) {
            case 0:
     PPCODE:
         switch (type) {
            case 0:
@@ -2106,7 +2343,7 @@ gv_autoload_type(stash, methname, type, method)
     PREINIT:
         STRLEN len;
         const char * const name = SvPV_const(methname, len);
     PREINIT:
         STRLEN len;
         const char * const name = SvPV_const(methname, len);
-       GV* gv;
+       GV* gv = NULL;
        I32 flags = method ? GV_AUTOLOAD_ISMETHOD : 0;
     PPCODE:
         switch (type) {
        I32 flags = method ? GV_AUTOLOAD_ISMETHOD : 0;
     PPCODE:
         switch (type) {
@@ -2132,7 +2369,7 @@ whichsig_type(namesv, type)
     PREINIT:
         STRLEN len;
         const char * const name = SvPV_const(namesv, len);
     PREINIT:
         STRLEN len;
         const char * const name = SvPV_const(namesv, len);
-        I32 i;
+        I32 i = 0;
     PPCODE:
         switch (type) {
            case 0:
     PPCODE:
         switch (type) {
            case 0:
@@ -2313,7 +2550,7 @@ my_caller(level)
         ST(4) = cop_hints_fetch_pvs(cx->blk_oldcop, "foo", 0);
         ST(5) = cop_hints_fetch_pvn(cx->blk_oldcop, "foo", 3, 0, 0);
         ST(6) = cop_hints_fetch_sv(cx->blk_oldcop, 
         ST(4) = cop_hints_fetch_pvs(cx->blk_oldcop, "foo", 0);
         ST(5) = cop_hints_fetch_pvn(cx->blk_oldcop, "foo", 3, 0, 0);
         ST(6) = cop_hints_fetch_sv(cx->blk_oldcop, 
-                sv_2mortal(newSVpvn("foo", 3)), 0, 0);
+                sv_2mortal(newSVpvs("foo")), 0, 0);
 
         hv = cop_hints_2hv(cx->blk_oldcop, 0);
         ST(7) = hv ? sv_2mortal(newRV_noinc((SV *)hv)) : &PL_sv_undef;
 
         hv = cop_hints_2hv(cx->blk_oldcop, 0);
         ST(7) = hv ? sv_2mortal(newRV_noinc((SV *)hv)) : &PL_sv_undef;
@@ -2364,6 +2601,7 @@ utf16_to_utf8 (sv, ...)
        SV *dest;
        I32 got; /* Gah, badly thought out APIs */
     CODE:
        SV *dest;
        I32 got; /* Gah, badly thought out APIs */
     CODE:
+       if (ix) (void)SvPV_force_nolen(sv);
        source = (U8 *)SvPVbyte(sv, len);
        /* Optionally only convert part of the buffer.  */      
        if (items > 1) {
        source = (U8 *)SvPVbyte(sv, len);
        /* Optionally only convert part of the buffer.  */      
        if (items > 1) {
@@ -2507,13 +2745,12 @@ void
 test_rv2cv_op_cv()
     PROTOTYPE:
     PREINIT:
 test_rv2cv_op_cv()
     PROTOTYPE:
     PREINIT:
-       GV *troc_gv, *wibble_gv;
+       GV *troc_gv;
        CV *troc_cv;
        OP *o;
     CODE:
        troc_gv = gv_fetchpv("XS::APItest::test_rv2cv_op_cv", 0, SVt_PVGV);
        troc_cv = get_cv("XS::APItest::test_rv2cv_op_cv", 0);
        CV *troc_cv;
        OP *o;
     CODE:
        troc_gv = gv_fetchpv("XS::APItest::test_rv2cv_op_cv", 0, SVt_PVGV);
        troc_cv = get_cv("XS::APItest::test_rv2cv_op_cv", 0);
-       wibble_gv = gv_fetchpv("XS::APItest::wibble", 0, SVt_PVGV);
        o = newCVREF(0, newGVOP(OP_GV, 0, troc_gv));
        if (rv2cv_op_cv(o, 0) != troc_cv) croak_fail();
        if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
        o = newCVREF(0, newGVOP(OP_GV, 0, troc_gv));
        if (rv2cv_op_cv(o, 0) != troc_cv) croak_fail();
        if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
@@ -3075,6 +3312,7 @@ CODE:
        MULTICALL;
     }
     POP_MULTICALL;
        MULTICALL;
     }
     POP_MULTICALL;
+    PERL_UNUSED_VAR(newsp);
     XSRETURN_UNDEF;
 }
 
     XSRETURN_UNDEF;
 }
 
@@ -3198,6 +3436,9 @@ BOOT:
     hintkey_arraytermexpr_sv = newSVpvs_share("XS::APItest/arraytermexpr");
     hintkey_arrayarithexpr_sv = newSVpvs_share("XS::APItest/arrayarithexpr");
     hintkey_arrayexprflags_sv = newSVpvs_share("XS::APItest/arrayexprflags");
     hintkey_arraytermexpr_sv = newSVpvs_share("XS::APItest/arraytermexpr");
     hintkey_arrayarithexpr_sv = newSVpvs_share("XS::APItest/arrayarithexpr");
     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");
+    hintkey_join_with_space_sv = newSVpvs_share("XS::APItest/join_with_space");
     next_keyword_plugin = PL_keyword_plugin;
     PL_keyword_plugin = my_keyword_plugin;
 }
     next_keyword_plugin = PL_keyword_plugin;
     PL_keyword_plugin = my_keyword_plugin;
 }
@@ -3295,7 +3536,7 @@ CV* cv
   for ( i = PadnamelistMAX(pad_namelist); i >= 0; i-- ) {
     PADNAME* name = PadnamelistARRAY(pad_namelist)[i];
 
   for ( i = PadnamelistMAX(pad_namelist); i >= 0; i-- ) {
     PADNAME* name = PadnamelistARRAY(pad_namelist)[i];
 
-    if (SvPOKp(name)) {
+    if (PadnameLEN(name)) {
         av_push(retav, newSVpadname(name));
     }
   }
         av_push(retav, newSVpadname(name));
     }
   }
@@ -3319,10 +3560,8 @@ OUTPUT:
 
 void
 stringify(SV *sv)
 
 void
 stringify(SV *sv)
-PREINIT:
-    const char *pv;
 CODE:
 CODE:
-    pv = SvPV_nolen(sv);
+    (void)SvPV_nolen(sv);
 
 SV *
 HvENAME(HV *hv)
 
 SV *
 HvENAME(HV *hv)
@@ -3350,6 +3589,8 @@ OUTPUT:
 SV *
 xs_cmp_undef(SV *a, SV *b)
 CODE:
 SV *
 xs_cmp_undef(SV *a, SV *b)
 CODE:
+    PERL_UNUSED_ARG(a);
+    PERL_UNUSED_ARG(b);
     RETVAL = &PL_sv_undef;
 OUTPUT:
     RETVAL
     RETVAL = &PL_sv_undef;
 OUTPUT:
     RETVAL
@@ -3394,7 +3635,6 @@ test_newFOROP_without_slab()
 CODE:
     {
        const I32 floor = start_subparse(0,0);
 CODE:
     {
        const I32 floor = start_subparse(0,0);
-       CV * const cv = PL_compcv;
        /* 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));
        /* 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));
@@ -3459,6 +3699,34 @@ sv_mortalcopy(SV *sv)
     OUTPUT:
        RETVAL
 
     OUTPUT:
        RETVAL
 
+SV *
+newRV(SV *sv)
+
+void
+alias_av(AV *av, IV ix, SV *sv)
+    CODE:
+       av_store(av, ix, SvREFCNT_inc(sv));
+
+SV *
+cv_name(SVREF ref, ...)
+    CODE:
+       RETVAL = SvREFCNT_inc(cv_name((CV *)ref,
+                                     items>1 && ST(1) != &PL_sv_undef
+                                       ? ST(1)
+                                       : NULL,
+                                     items>2 ? SvUV(ST(2)) : 0));
+    OUTPUT:
+       RETVAL
+
+void
+sv_catpvn(SV *sv, SV *sv2)
+    CODE:
+    {
+       STRLEN len;
+       const char *s = SvPV(sv2,len);
+       sv_catpvn_flags(sv,s,len, SvUTF8(sv2) ? SV_CATUTF8 : SV_CATBYTES);
+    }
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int
@@ -3466,8 +3734,8 @@ AUTOLOAD(...)
   INIT:
     SV* comms;
     SV* class_and_method;
   INIT:
     SV* comms;
     SV* class_and_method;
-    SV* tmp;
   CODE:
   CODE:
+    PERL_UNUSED_ARG(items);
     class_and_method = GvSV(CvGV(cv));
     comms = get_sv("main::the_method", 1);
     if (class_and_method == NULL) {
     class_and_method = GvSV(CvGV(cv));
     comms = get_sv("main::the_method", 1);
     if (class_and_method == NULL) {
@@ -3518,7 +3786,7 @@ test_get_vtbl()
        MGVTBL *want;
     CODE:
 #define test_get_this_vtable(name) \
        MGVTBL *want;
     CODE:
 #define test_get_this_vtable(name) \
-       want = CAT2(&PL_vtbl_, name); \
+       want = (MGVTBL*)CAT2(&PL_vtbl_, name); \
        have = get_vtbl(CAT2(want_vtbl_, name)); \
        if (have != want) \
            croak("fail %p!=%p for get_vtbl(want_vtbl_" STRINGIFY(name) ") at " __FILE__ " line %d", have, want, __LINE__)
        have = get_vtbl(CAT2(want_vtbl_, name)); \
        if (have != want) \
            croak("fail %p!=%p for get_vtbl(want_vtbl_" STRINGIFY(name) ") at " __FILE__ " line %d", have, want, __LINE__)
@@ -4444,3 +4712,242 @@ test_isQUOTEMETA(UV ord)
         RETVAL = _isQUOTEMETA(ord);
     OUTPUT:
         RETVAL
         RETVAL = _isQUOTEMETA(ord);
     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_utf8(SV * p)
+    PREINIT:
+        U8 *input;
+        U8 s[UTF8_MAXBYTES_CASE + 1];
+        STRLEN len;
+        AV *av;
+        SV *utf8;
+    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;
+    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:
+        av = newAV();
+        av_push(av, newSVuv(toFOLD_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_toFOLD_utf8(SV * p)
+    PREINIT:
+        U8 *input;
+        U8 s[UTF8_MAXBYTES_CASE + 1];
+        STRLEN len;
+        AV *av;
+        SV *utf8;
+    CODE:
+        input = (U8 *) SvPV(p, len);
+        av = newAV();
+        av_push(av, newSVuv(toFOLD_utf8(input, s, &len)));
+
+        utf8 = newSVpvn((char *) s, len);
+        SvUTF8_on(utf8);
+        av_push(av, utf8);
+
+        av_push(av, newSVuv(len));
+        RETVAL = av;
+    OUTPUT:
+        RETVAL
+
+UV
+test_toUPPER(UV ord)
+    CODE:
+        RETVAL = toUPPER(ord);
+    OUTPUT:
+        RETVAL
+
+UV
+test_toUPPER_LC(UV ord)
+    CODE:
+        RETVAL = toUPPER_LC(ord);
+    OUTPUT:
+        RETVAL
+
+AV *
+test_toUPPER_uni(UV ord)
+    PREINIT:
+        U8 s[UTF8_MAXBYTES_CASE + 1];
+        STRLEN len;
+        AV *av;
+        SV *utf8;
+    CODE:
+        av = newAV();
+        av_push(av, newSVuv(toUPPER_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_toUPPER_utf8(SV * p)
+    PREINIT:
+        U8 *input;
+        U8 s[UTF8_MAXBYTES_CASE + 1];
+        STRLEN len;
+        AV *av;
+        SV *utf8;
+    CODE:
+        input = (U8 *) SvPV(p, len);
+        av = newAV();
+        av_push(av, newSVuv(toUPPER_utf8(input, s, &len)));
+
+        utf8 = newSVpvn((char *) s, len);
+        SvUTF8_on(utf8);
+        av_push(av, utf8);
+
+        av_push(av, newSVuv(len));
+        RETVAL = av;
+    OUTPUT:
+        RETVAL
+
+UV
+test_toTITLE(UV ord)
+    CODE:
+        RETVAL = toTITLE(ord);
+    OUTPUT:
+        RETVAL
+
+AV *
+test_toTITLE_uni(UV ord)
+    PREINIT:
+        U8 s[UTF8_MAXBYTES_CASE + 1];
+        STRLEN len;
+        AV *av;
+        SV *utf8;
+    CODE:
+        av = newAV();
+        av_push(av, newSVuv(toTITLE_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_toTITLE_utf8(SV * p)
+    PREINIT:
+        U8 *input;
+        U8 s[UTF8_MAXBYTES_CASE + 1];
+        STRLEN len;
+        AV *av;
+        SV *utf8;
+    CODE:
+        input = (U8 *) SvPV(p, len);
+        av = newAV();
+        av_push(av, newSVuv(toTITLE_utf8(input, s, &len)));
+
+        utf8 = newSVpvn((char *) s, len);
+        SvUTF8_on(utf8);
+        av_push(av, utf8);
+
+        av_push(av, newSVuv(len));
+        RETVAL = av;
+    OUTPUT:
+        RETVAL
+
+SV *
+test_Gconvert(SV * number, SV * num_digits)
+    PREINIT:
+        char buffer[100];
+        int len;
+    CODE:
+        len = (int) SvIV(num_digits);
+        if (len > 99) croak("Too long a number for test_Gconvert");
+        PERL_UNUSED_RESULT(Gconvert(SvNV(number), len,
+                 0,    /* No trailing zeroes */
+                 buffer));
+        RETVAL = newSVpv(buffer, 0);
+    OUTPUT:
+        RETVAL