This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Tests for XS AUTOLOAD routines
[perl5.git] / ext / XS-APItest / APItest.xs
index c7317bc..96efeb4 100644 (file)
@@ -1517,6 +1517,16 @@ void
 ptr_table_clear(table)
 XS::APItest::PtrTable table
 
+MODULE = XS::APItest::AutoLoader       PACKAGE = XS::APItest::AutoLoader
+
+SV *
+AUTOLOAD()
+    CODE:
+       RETVAL = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SvUTF8(cv));
+    OUTPUT:
+       RETVAL
+
+
 MODULE = XS::APItest           PACKAGE = XS::APItest
 
 PROTOTYPES: DISABLE
@@ -1840,6 +1850,27 @@ call_method(methname, flags, ...)
        PUSHs(sv_2mortal(newSViv(i)));
 
 void
+newCONSTSUB_type(stash, name, flags, type)
+    HV* stash
+    SV* name
+    I32 flags
+    int type
+    PREINIT:
+       CV* cv;
+    PPCODE:
+        switch (type) {
+           case 0:
+              cv = newCONSTSUB(stash, SvPV_nolen(name), NULL);
+               break;
+           case 1:
+               cv = newCONSTSUB_flags(stash, SvPV_nolen(name), flags | SvUTF8(name), NULL);
+               break;
+        }
+        EXTEND(SP, 2);
+        PUSHs( CvCONST(cv) ? &PL_sv_yes : &PL_sv_no );
+       PUSHs((SV*)CvGV(cv));
+
+void
 gv_init_type(namesv, multi, flags, type)
     SV* namesv
     int multi
@@ -1852,18 +1883,19 @@ gv_init_type(namesv, multi, flags, type)
     PPCODE:
         if (SvTYPE(gv) == SVt_PVGV)
             Perl_croak(aTHX_ "GV is already a PVGV");
+        if (multi) flags |= GV_ADDMULTI;
         switch (type) {
            case 0:
               gv_init(gv, PL_defstash, name, len, multi);
                break;
            case 1:
-               gv_init_sv(gv, PL_defstash, namesv, multi, flags);
+               gv_init_sv(gv, PL_defstash, namesv, flags);
                break;
            case 2:
-               gv_init_pv(gv, PL_defstash, name, multi, flags | SvUTF8(namesv));
+               gv_init_pv(gv, PL_defstash, name, flags | SvUTF8(namesv));
                break;
            case 3:
-               gv_init_pvn(gv, PL_defstash, name, len, multi, flags | SvUTF8(namesv));
+               gv_init_pvn(gv, PL_defstash, name, len, flags | SvUTF8(namesv));
                break;
         }
        XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
@@ -1950,10 +1982,62 @@ gv_fetchmethod_flags_type(stash, methname, type, flags)
                break;
             }
         }
+       XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
 
+void
+gv_autoload_type(stash, methname, type, method)
+    HV* stash
+    SV* methname
+    int type
+    I32 method
+    PREINIT:
+        STRLEN len;
+        const char * const name = SvPV_const(methname, len);
+       GV* gv;
+       I32 flags = method ? GV_AUTOLOAD_ISMETHOD : 0;
+    PPCODE:
+        switch (type) {
+           case 0:
+              gv = gv_autoload4(stash, name, len, method);
+               break;
+           case 1:
+               gv = gv_autoload_sv(stash, methname, flags);
+               break;
+           case 2:
+               gv = gv_autoload_pv(stash, name, flags | SvUTF8(methname));
+               break;
+           case 3:
+               gv = gv_autoload_pvn(stash, name, len, flags | SvUTF8(methname));
+               break;
+        }
        XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
 
 void
+whichsig_type(namesv, type)
+    SV* namesv
+    int type
+    PREINIT:
+        STRLEN len;
+        const char * const name = SvPV_const(namesv, len);
+        I32 i;
+    PPCODE:
+        switch (type) {
+           case 0:
+              i = whichsig(name);
+               break;
+           case 1:
+               i = whichsig_sv(namesv);
+               break;
+           case 2:
+               i = whichsig_pv(name);
+               break;
+           case 3:
+               i = whichsig_pvn(name, len);
+               break;
+        }
+        XPUSHs(sv_2mortal(newSViv(i)));
+
+void
 eval_sv(sv, flags)
     SV* sv
     I32 flags
@@ -3104,6 +3188,18 @@ PREINIT:
 CODE:
     pv = SvPV_nolen(sv);
 
+SV *
+HvENAME(HV *hv)
+CODE:
+    RETVAL = hv && HvENAME(hv)
+             ? newSVpvn_flags(
+                 HvENAME(hv),HvENAMELEN(hv),
+                 (HvENAMEUTF8(hv) ? SVf_UTF8 : 0)
+               )
+             : NULL;
+OUTPUT:
+    RETVAL
+
 
 MODULE = XS::APItest           PACKAGE = XS::APItest::Magic