new is a reserved word in C++, don't use it as a variable name

[perl5.git] / ext / XS-APItest / APItest.xs

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 7e7f78b..3b90d95 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3,6 +3,8 @@
 #include "perl.h"
 #include "XSUB.h"
 
+typedef SV *SVREF;
+typedef PTR_TBL_t *XS__APItest__PtrTable;
 
 /* for my_cxt tests */
 
@@ -11,6 +13,10 @@
 typedef struct {
     int i;
     SV *sv;
+    GV *cscgv;
+    AV *cscav;
+    AV *bhkav;
+    bool bhk_record;
 } my_cxt_t;
 
 START_MY_CXT
@@ -240,6 +246,87 @@ rmagical_a_dummy(pTHX_ IV idx, SV *sv) {
 
 STATIC MGVTBL rmagical_b = { 0 };
 
+STATIC void
+blockhook_csc_start(pTHX_ int full)
+{
+    dMY_CXT;
+    AV *const cur = GvAV(MY_CXT.cscgv);
+
+    SAVEGENERICSV(GvAV(MY_CXT.cscgv));
+
+    if (cur) {
+        I32 i;
+        AV *const new_av = newAV();
+
+        for (i = 0; i <= av_len(cur); i++) {
+            av_store(new_av, i, newSVsv(*av_fetch(cur, i, 0)));
+        }
+
+        GvAV(MY_CXT.cscgv) = new_av;
+    }
+}
+
+STATIC void
+blockhook_csc_pre_end(pTHX_ OP **o)
+{
+    dMY_CXT;
+
+    /* if we hit the end of a scope we missed the start of, we need to
+     * unconditionally clear @CSC */
+    if (GvAV(MY_CXT.cscgv) == MY_CXT.cscav && MY_CXT.cscav) {
+        av_clear(MY_CXT.cscav);
+    }
+
+}
+
+STATIC void
+blockhook_test_start(pTHX_ int full)
+{
+    dMY_CXT;
+    AV *av;
+    
+    if (MY_CXT.bhk_record) {
+        av = newAV();
+        av_push(av, newSVpvs("start"));
+        av_push(av, newSViv(full));
+        av_push(MY_CXT.bhkav, newRV_noinc(MUTABLE_SV(av)));
+    }
+}
+
+STATIC void
+blockhook_test_pre_end(pTHX_ OP **o)
+{
+    dMY_CXT;
+
+    if (MY_CXT.bhk_record)
+        av_push(MY_CXT.bhkav, newSVpvs("pre_end"));
+}
+
+STATIC void
+blockhook_test_post_end(pTHX_ OP **o)
+{
+    dMY_CXT;
+
+    if (MY_CXT.bhk_record)
+        av_push(MY_CXT.bhkav, newSVpvs("post_end"));
+}
+
+STATIC void
+blockhook_test_eval(pTHX_ OP *const o)
+{
+    dMY_CXT;
+    AV *av;
+
+    if (MY_CXT.bhk_record) {
+        av = newAV();
+        av_push(av, newSVpvs("eval"));
+        av_push(av, newSVpv(OP_NAME(o), 0));
+        av_push(MY_CXT.bhkav, newRV_noinc(MUTABLE_SV(av)));
+    }
+}
+
+STATIC BHK bhk_csc, bhk_test;
+
 #include "const-c.inc"
 
 MODULE = XS::APItest:Hash              PACKAGE = XS::APItest::Hash
@@ -547,6 +634,45 @@ sub CLEAR    { %{$_[0]} = () }
 
 =cut
 
+MODULE = XS::APItest::PtrTable PACKAGE = XS::APItest::PtrTable PREFIX = ptr_table_
+
+void
+ptr_table_new(classname)
+const char * classname
+    PPCODE:
+    PUSHs(sv_setref_pv(sv_newmortal(), classname, (void*)ptr_table_new()));
+
+void
+DESTROY(table)
+XS::APItest::PtrTable table
+    CODE:
+    ptr_table_free(table);
+
+void
+ptr_table_store(table, from, to)
+XS::APItest::PtrTable table
+SVREF from
+SVREF to
+   CODE:
+   ptr_table_store(table, from, to);
+
+UV
+ptr_table_fetch(table, from)
+XS::APItest::PtrTable table
+SVREF from
+   CODE:
+   RETVAL = PTR2UV(ptr_table_fetch(table, from));
+   OUTPUT:
+   RETVAL
+
+void
+ptr_table_split(table)
+XS::APItest::PtrTable table
+
+void
+ptr_table_clear(table)
+XS::APItest::PtrTable table
+
 MODULE = XS::APItest           PACKAGE = XS::APItest
 
 PROTOTYPES: DISABLE
@@ -554,8 +680,26 @@ PROTOTYPES: DISABLE
 BOOT:
 {
     MY_CXT_INIT;
+
     MY_CXT.i  = 99;
     MY_CXT.sv = newSVpv("initial",0);
+
+    MY_CXT.bhkav = get_av("XS::APItest::bhkav", GV_ADDMULTI);
+    MY_CXT.bhk_record = 0;
+
+    BhkENTRY_set(&bhk_test, start, blockhook_test_start);
+    BhkENTRY_set(&bhk_test, pre_end, blockhook_test_pre_end);
+    BhkENTRY_set(&bhk_test, post_end, blockhook_test_post_end);
+    BhkENTRY_set(&bhk_test, eval, blockhook_test_eval);
+    Perl_blockhook_register(aTHX_ &bhk_test);
+
+    MY_CXT.cscgv = gv_fetchpvs("XS::APItest::COMPILE_SCOPE_CONTAINER", 
+        GV_ADDMULTI, SVt_PVAV);
+    MY_CXT.cscav = GvAV(MY_CXT.cscgv);
+
+    BhkENTRY_set(&bhk_csc, start, blockhook_csc_start);
+    BhkENTRY_set(&bhk_csc, pre_end, blockhook_csc_pre_end);
+    Perl_blockhook_register(aTHX_ &bhk_csc);
 }                              
 
 void
@@ -563,6 +707,11 @@ CLONE(...)
     CODE:
     MY_CXT_CLONE;
     MY_CXT.sv = newSVpv("initial_clone",0);
+    MY_CXT.cscgv = gv_fetchpvs("XS::APItest::COMPILE_SCOPE_CONTAINER", 
+        GV_ADDMULTI, SVt_PVAV);
+    MY_CXT.cscav = NULL;
+    MY_CXT.bhkav = get_av("XS::APItest::bhkav", GV_ADDMULTI);
+    MY_CXT.bhk_record = 0;
 
 void
 print_double(val)
@@ -892,3 +1041,52 @@ void
 END()
     CODE:
        sv_inc(get_sv("XS::APItest::END_called", GV_ADD|GV_ADDMULTI));
+
+void
+utf16_to_utf8 (sv, ...)
+    SV* sv
+       ALIAS:
+           utf16_to_utf8_reversed = 1
+    PREINIT:
+        STRLEN len;
+       U8 *source;
+       SV *dest;
+       I32 got; /* Gah, badly thought out APIs */
+    CODE:
+       source = (U8 *)SvPVbyte(sv, len);
+       /* Optionally only convert part of the buffer.  */      
+       if (items > 1) {
+           len = SvUV(ST(1));
+       }
+       /* Mortalise this right now, as we'll be testing croak()s  */
+       dest = sv_2mortal(newSV(len * 3 / 2 + 1));
+       if (ix) {
+           utf16_to_utf8_reversed(source, (U8 *)SvPVX(dest), len, &got);
+       } else {
+           utf16_to_utf8(source, (U8 *)SvPVX(dest), len, &got);
+       }
+       SvCUR_set(dest, got);
+       SvPVX(dest)[got] = '\0';
+       SvPOK_on(dest);
+       ST(0) = dest;
+       XSRETURN(1);
+
+void
+my_exit(int exitcode)
+        PPCODE:
+        my_exit(exitcode);
+
+I32
+sv_count()
+        CODE:
+           RETVAL = PL_sv_count;
+       OUTPUT:
+           RETVAL
+
+void
+bhk_record(bool on)
+    CODE:
+        dMY_CXT;
+        MY_CXT.bhk_record = on;
+        if (on)
+            av_clear(MY_CXT.bhkav);