This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
More PAD APIs
[perl5.git] / ext / XS-APItest / APItest.xs
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 2c0ee61..fb42935 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1101,6 +1101,29 @@ addissub_myck_add(pTHX_ OP *op)
     return newBINOP(OP_SUBTRACT, flags, aop, bop);
 }
 
+static Perl_check_t old_ck_rv2cv;
+
+static OP *
+my_ck_rv2cv(pTHX_ OP *o)
+{
+    SV *ref;
+    SV **flag_svp = hv_fetchs(GvHV(PL_hintgv), "XS::APItest/addunder", 0);
+    OP *aop;
+
+    if (flag_svp && SvTRUE(*flag_svp) && (o->op_flags & OPf_KIDS)
+     && (aop = cUNOPx(o)->op_first) && aop->op_type == OP_CONST
+     && aop->op_private & (OPpCONST_ENTERED|OPpCONST_BARE)
+     && (ref = cSVOPx(aop)->op_sv) && SvPOK(ref) && SvCUR(ref)
+     && *(SvEND(ref)-1) == 'o')
+    {
+       SvGROW(ref, SvCUR(ref)+2);
+       *SvEND(ref) = '_';
+       SvCUR(ref)++;
+       *SvEND(ref) = '\0';
+    }
+    return old_ck_rv2cv(aTHX_ o);
+}
+
 #include "const-c.inc"
 
 MODULE = XS::APItest           PACKAGE = XS::APItest
@@ -1934,30 +1957,31 @@ call_method(methname, flags, ...)
        PUSHs(sv_2mortal(newSViv(i)));
 
 void
-newCONSTSUB_type(stash, name, flags, type, sv)
+newCONSTSUB(stash, name, flags, sv)
     HV* stash
     SV* name
     I32 flags
-    int type
     SV* sv
+    ALIAS:
+       newCONSTSUB_flags = 1
     PREINIT:
-       CV* cv;
+       CV* mycv;
        STRLEN len;
        const char *pv = SvPV(name, len);
     PPCODE:
-        switch (type) {
+        switch (ix) {
            case 0:
-              cv = newCONSTSUB(stash, pv, SvOK(sv) ? sv : NULL);
+               mycv = newCONSTSUB(stash, pv, SvOK(sv) ? SvREFCNT_inc(sv) : NULL);
                break;
            case 1:
-               cv = newCONSTSUB_flags(
-                 stash, pv, len, flags | SvUTF8(name), SvOK(sv) ? sv : NULL
+               mycv = newCONSTSUB_flags(
+                 stash, pv, len, flags | SvUTF8(name), SvOK(sv) ? SvREFCNT_inc(sv) : NULL
                );
                break;
         }
         EXTEND(SP, 2);
-        PUSHs( CvCONST(cv) ? &PL_sv_yes : &PL_sv_no );
-       PUSHs((SV*)CvGV(cv));
+        PUSHs( CvCONST(mycv) ? &PL_sv_yes : &PL_sv_no );
+        PUSHs((SV*)CvGV(mycv));
 
 void
 gv_init_type(namesv, multi, flags, type)
@@ -3084,7 +3108,8 @@ CODE:
     PERL_SET_CONTEXT(interp_dup);
 
     /* continue after 'clone_with_stack' */
-    interp_dup->Iop = interp_dup->Iop->op_next;
+    if (interp_dup->Iop)
+       interp_dup->Iop = interp_dup->Iop->op_next;
 
     /* run with new perl */
     Perl_runops_standard(interp_dup);
@@ -3262,16 +3287,16 @@ fetch_pad_names( cv )
 CV* cv
  PREINIT:
   I32 i;
-  AV *pad_namelist;
+  PADNAMELIST *pad_namelist;
   AV *retav = newAV();
  CODE:
-  pad_namelist = (AV*) *av_fetch(CvPADLIST(cv), 0, FALSE);
+  pad_namelist = PADLIST_NAMES(CvPADLIST(cv));
 
-  for ( i = av_len(pad_namelist); i >= 0; i-- ) {
-    SV** name_ptr = av_fetch(pad_namelist, i, 0);
+  for ( i = PADNAMELIST_MAX(pad_namelist); i >= 0; i-- ) {
+    PADNAME* name = PADNAMELIST_ARRAY(pad_namelist)[i];
 
-    if (name_ptr && SvPOKp(*name_ptr)) {
-        av_push(retav, newSVsv(*name_ptr));
+    if (SvPOKp(name)) {
+        av_push(retav, newSVpadname(name));
     }
   }
   RETVAL = newRV_noinc((SV*)retav);
@@ -3348,6 +3373,11 @@ setup_addissub()
 CODE:
     wrap_op_checker(OP_ADD, addissub_myck_add, &addissub_nxck_add);
 
+void
+setup_rv2cv_addunderbar()
+CODE:
+    wrap_op_checker(OP_RV2CV, my_ck_rv2cv, &old_ck_rv2cv);
+
 #ifdef USE_ITHREADS
 
 bool
@@ -3359,6 +3389,25 @@ OUTPUT:
 
 #endif
 
+bool
+test_newFOROP_without_slab()
+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));
+       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
+
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int
@@ -3455,3 +3504,444 @@ test_get_vtbl()
        RETVAL = PTR2UV(get_vtbl(-1));
     OUTPUT:
        RETVAL
+
+bool
+test_isBLANK_uni(UV ord)
+    CODE:
+        RETVAL = isBLANK_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isBLANK_A(UV ord)
+    CODE:
+        RETVAL = isBLANK_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isBLANK_L1(UV ord)
+    CODE:
+        RETVAL = isBLANK_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isBLANK_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isBLANK_utf8(p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isUPPER_uni(UV ord)
+    CODE:
+        RETVAL = isUPPER_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isUPPER_A(UV ord)
+    CODE:
+        RETVAL = isUPPER_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isUPPER_L1(UV ord)
+    CODE:
+        RETVAL = isUPPER_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isUPPER_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isUPPER_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isLOWER_uni(UV ord)
+    CODE:
+        RETVAL = isLOWER_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isLOWER_A(UV ord)
+    CODE:
+        RETVAL = isLOWER_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isLOWER_L1(UV ord)
+    CODE:
+        RETVAL = isLOWER_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isLOWER_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isLOWER_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALPHA_uni(UV ord)
+    CODE:
+        RETVAL = isALPHA_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALPHA_A(UV ord)
+    CODE:
+        RETVAL = isALPHA_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALPHA_L1(UV ord)
+    CODE:
+        RETVAL = isALPHA_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALPHA_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isALPHA_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALNUM_uni(UV ord)
+    CODE:
+        RETVAL = isALNUM_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALNUM_A(UV ord)
+    CODE:
+        RETVAL = isWORDCHAR_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALNUM_L1(UV ord)
+    CODE:
+        RETVAL = isWORDCHAR_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALNUM_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isALNUM_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isDIGIT_uni(UV ord)
+    CODE:
+        RETVAL = isDIGIT_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isDIGIT_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isDIGIT_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isDIGIT_A(UV ord)
+    CODE:
+        RETVAL = isDIGIT_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isDIGIT_L1(UV ord)
+    CODE:
+        RETVAL = isDIGIT_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isIDFIRST_uni(UV ord)
+    CODE:
+        RETVAL = isIDFIRST_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isIDFIRST_A(UV ord)
+    CODE:
+        RETVAL = isIDFIRST_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isIDFIRST_L1(UV ord)
+    CODE:
+        RETVAL = isIDFIRST_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isIDFIRST_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isIDFIRST_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isSPACE_uni(UV ord)
+    CODE:
+        RETVAL = isSPACE_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isSPACE_A(UV ord)
+    CODE:
+        RETVAL = isSPACE_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isSPACE_L1(UV ord)
+    CODE:
+        RETVAL = isSPACE_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isSPACE_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isSPACE_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isASCII_uni(UV ord)
+    CODE:
+        RETVAL = isASCII_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isASCII_A(UV ord)
+    CODE:
+        RETVAL = isASCII_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isASCII_L1(UV ord)
+    CODE:
+        RETVAL = isASCII_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isASCII_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isASCII_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isCNTRL_uni(UV ord)
+    CODE:
+        RETVAL = isCNTRL_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isCNTRL_A(UV ord)
+    CODE:
+        RETVAL = isCNTRL_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isCNTRL_L1(UV ord)
+    CODE:
+        RETVAL = isCNTRL_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isCNTRL_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isCNTRL_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPRINT_uni(UV ord)
+    CODE:
+        RETVAL = isPRINT_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPRINT_A(UV ord)
+    CODE:
+        RETVAL = isPRINT_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPRINT_L1(UV ord)
+    CODE:
+        RETVAL = isPRINT_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPRINT_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isPRINT_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isGRAPH_uni(UV ord)
+    CODE:
+        RETVAL = isGRAPH_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isGRAPH_A(UV ord)
+    CODE:
+        RETVAL = isGRAPH_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isGRAPH_L1(UV ord)
+    CODE:
+        RETVAL = isGRAPH_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isGRAPH_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isGRAPH_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALNUMC_A(UV ord)
+    CODE:
+        RETVAL = isALNUMC_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isALNUMC_L1(UV ord)
+    CODE:
+        RETVAL = isALNUMC_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPUNCT_uni(UV ord)
+    CODE:
+        RETVAL = isPUNCT_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPUNCT_A(UV ord)
+    CODE:
+        RETVAL = isPUNCT_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPUNCT_L1(UV ord)
+    CODE:
+        RETVAL = isPUNCT_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPUNCT_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isPUNCT_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isXDIGIT_uni(UV ord)
+    CODE:
+        RETVAL = isXDIGIT_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isXDIGIT_A(UV ord)
+    CODE:
+        RETVAL = isXDIGIT_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isXDIGIT_L1(UV ord)
+    CODE:
+        RETVAL = isXDIGIT_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isXDIGIT_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isXDIGIT_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPSXSPC_uni(UV ord)
+    CODE:
+        RETVAL = isPSXSPC_uni(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPSXSPC_A(UV ord)
+    CODE:
+        RETVAL = isPSXSPC_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPSXSPC_L1(UV ord)
+    CODE:
+        RETVAL = isPSXSPC_L1(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isPSXSPC_utf8(unsigned char * p)
+    CODE:
+        RETVAL = isPSXSPC_utf8( p);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isQUOTEMETA(UV ord)
+    CODE:
+        RETVAL = _isQUOTEMETA(ord);
+    OUTPUT:
+        RETVAL
Unnamed repository; edit this file 'description' to name the repository.