ext/XS/APItest/APItest.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5
   6 MODULE = XS::APItest:Hash               PACKAGE = XS::APItest::Hash
   7
   8 #define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)
   9
  10 bool
  11 exists(hash, key_sv)
  12         PREINIT:
  13         STRLEN len;
  14         const char *key;
  15         INPUT:
  16         HV *hash
  17         SV *key_sv
  18         CODE:
  19         key = SvPV(key_sv, len);
  20         RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
  21         OUTPUT:
  22         RETVAL
  23
  24 SV *
  25 delete(hash, key_sv)
  26         PREINIT:
  27         STRLEN len;
  28         const char *key;
  29         INPUT:
  30         HV *hash
  31         SV *key_sv
  32         CODE:
  33         key = SvPV(key_sv, len);
  34         /* It's already mortal, so need to increase reference count.  */
  35         RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
  36         OUTPUT:
  37         RETVAL
  38
  39 SV *
  40 store_ent(hash, key, value)
  41         PREINIT:
  42         SV *copy;
  43         HE *result;
  44         INPUT:
  45         HV *hash
  46         SV *key
  47         SV *value
  48         CODE:
  49         copy = newSV(0);
  50         result = hv_store_ent(hash, key, copy, 0);
  51         SvSetMagicSV(copy, value);
  52         if (!result) {
  53             SvREFCNT_dec(copy);
  54             XSRETURN_EMPTY;
  55         }
  56         /* It's about to become mortal, so need to increase reference count.
  57          */
  58         RETVAL = SvREFCNT_inc(HeVAL(result));
  59         OUTPUT:
  60         RETVAL
  61
  62
  63 SV *
  64 store(hash, key_sv, value)
  65         PREINIT:
  66         STRLEN len;
  67         const char *key;
  68         SV *copy;
  69         SV **result;
  70         INPUT:
  71         HV *hash
  72         SV *key_sv
  73         SV *value
  74         CODE:
  75         key = SvPV(key_sv, len);
  76         copy = newSV(0);
  77         result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
  78         SvSetMagicSV(copy, value);
  79         if (!result) {
  80             SvREFCNT_dec(copy);
  81             XSRETURN_EMPTY;
  82         }
  83         /* It's about to become mortal, so need to increase reference count.
  84          */
  85         RETVAL = SvREFCNT_inc(*result);
  86         OUTPUT:
  87         RETVAL
  88
  89
  90 SV *
  91 fetch(hash, key_sv)
  92         PREINIT:
  93         STRLEN len;
  94         const char *key;
  95         SV **result;
  96         INPUT:
  97         HV *hash
  98         SV *key_sv
  99         CODE:
 100         key = SvPV(key_sv, len);
 101         result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
 102         if (!result) {
 103             XSRETURN_EMPTY;
 104         }
 105         /* Force mg_get  */
 106         RETVAL = newSVsv(*result);
 107         OUTPUT:
 108         RETVAL
 109 =pod
 110
 111 sub TIEHASH  { bless {}, $_[0] }
 112 sub STORE    { $_[0]->{$_[1]} = $_[2] }
 113 sub FETCH    { $_[0]->{$_[1]} }
 114 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
 115 sub NEXTKEY  { each %{$_[0]} }
 116 sub EXISTS   { exists $_[0]->{$_[1]} }
 117 sub DELETE   { delete $_[0]->{$_[1]} }
 118 sub CLEAR    { %{$_[0]} = () }
 119
 120 =cut
 121
 122 MODULE = XS::APItest            PACKAGE = XS::APItest
 123
 124 PROTOTYPES: DISABLE
 125
 126 void
 127 print_double(val)
 128         double val
 129         CODE:
 130         printf("%5.3f\n",val);
 131
 132 int
 133 have_long_double()
 134         CODE:
 135 #ifdef HAS_LONG_DOUBLE
 136         RETVAL = 1;
 137 #else
 138         RETVAL = 0;
 139 #endif
 140         OUTPUT:
 141         RETVAL
 142
 143 void
 144 print_long_double()
 145         CODE:
 146 #ifdef HAS_LONG_DOUBLE
 147 #   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
 148         long double val = 7.0;
 149         printf("%5.3" PERL_PRIfldbl "\n",val);
 150 #   else
 151         double val = 7.0;
 152         printf("%5.3f\n",val);
 153 #   endif
 154 #endif
 155
 156 void
 157 print_int(val)
 158         int val
 159         CODE:
 160         printf("%d\n",val);
 161
 162 void
 163 print_long(val)
 164         long val
 165         CODE:
 166         printf("%ld\n",val);
 167
 168 void
 169 print_float(val)
 170         float val
 171         CODE:
 172         printf("%5.3f\n",val);
 173
 174 void
 175 print_flush()
 176         CODE:
 177         fflush(stdout);
 178
 179 void
 180 mpushp()
 181         PPCODE:
 182         EXTEND(SP, 3);
 183         mPUSHp("one", 3);
 184         mPUSHp("two", 3);
 185         mPUSHp("three", 5);
 186         XSRETURN(3);
 187
 188 void
 189 mpushn()
 190         PPCODE:
 191         EXTEND(SP, 3);
 192         mPUSHn(0.5);
 193         mPUSHn(-0.25);
 194         mPUSHn(0.125);
 195         XSRETURN(3);
 196
 197 void
 198 mpushi()
 199         PPCODE:
 200         EXTEND(SP, 3);
 201         mPUSHi(-1);
 202         mPUSHi(2);
 203         mPUSHi(-3);
 204         XSRETURN(3);
 205
 206 void
 207 mpushu()
 208         PPCODE:
 209         EXTEND(SP, 3);
 210         mPUSHu(1);
 211         mPUSHu(2);
 212         mPUSHu(3);
 213         XSRETURN(3);
 214
 215 void
 216 mxpushp()
 217         PPCODE:
 218         mXPUSHp("one", 3);
 219         mXPUSHp("two", 3);
 220         mXPUSHp("three", 5);
 221         XSRETURN(3);
 222
 223 void
 224 mxpushn()
 225         PPCODE:
 226         mXPUSHn(0.5);
 227         mXPUSHn(-0.25);
 228         mXPUSHn(0.125);
 229         XSRETURN(3);
 230
 231 void
 232 mxpushi()
 233         PPCODE:
 234         mXPUSHi(-1);
 235         mXPUSHi(2);
 236         mXPUSHi(-3);
 237         XSRETURN(3);
 238
 239 void
 240 mxpushu()
 241         PPCODE:
 242         mXPUSHu(1);
 243         mXPUSHu(2);
 244         mXPUSHu(3);
 245         XSRETURN(3);
 246
 247
 248 void
 249 call_sv(sv, flags, ...)
 250     SV* sv
 251     I32 flags
 252     PREINIT:
 253         I32 i;
 254     PPCODE:
 255         for (i=0; i<items-2; i++)
 256             ST(i) = ST(i+2); /* pop first two args */
 257         PUSHMARK(SP);
 258         SP += items - 2;
 259         PUTBACK;
 260         i = call_sv(sv, flags);
 261         SPAGAIN;
 262         EXTEND(SP, 1);
 263         PUSHs(sv_2mortal(newSViv(i)));
 264
 265 void
 266 call_pv(subname, flags, ...)
 267     char* subname
 268     I32 flags
 269     PREINIT:
 270         I32 i;
 271     PPCODE:
 272         for (i=0; i<items-2; i++)
 273             ST(i) = ST(i+2); /* pop first two args */
 274         PUSHMARK(SP);
 275         SP += items - 2;
 276         PUTBACK;
 277         i = call_pv(subname, flags);
 278         SPAGAIN;
 279         EXTEND(SP, 1);
 280         PUSHs(sv_2mortal(newSViv(i)));
 281
 282 void
 283 call_method(methname, flags, ...)
 284     char* methname
 285     I32 flags
 286     PREINIT:
 287         I32 i;
 288     PPCODE:
 289         for (i=0; i<items-2; i++)
 290             ST(i) = ST(i+2); /* pop first two args */
 291         PUSHMARK(SP);
 292         SP += items - 2;
 293         PUTBACK;
 294         i = call_method(methname, flags);
 295         SPAGAIN;
 296         EXTEND(SP, 1);
 297         PUSHs(sv_2mortal(newSViv(i)));
 298
 299 void
 300 eval_sv(sv, flags)
 301     SV* sv
 302     I32 flags
 303     PREINIT:
 304         I32 i;
 305     PPCODE:
 306         PUTBACK;
 307         i = eval_sv(sv, flags);
 308         SPAGAIN;
 309         EXTEND(SP, 1);
 310         PUSHs(sv_2mortal(newSViv(i)));
 311
 312 SV*
 313 eval_pv(p, croak_on_error)
 314     const char* p
 315     I32 croak_on_error
 316     PREINIT:
 317         I32 i;
 318     PPCODE:
 319         PUTBACK;
 320         EXTEND(SP, 1);
 321         PUSHs(eval_pv(p, croak_on_error));
 322
 323 void
 324 require_pv(pv)
 325     const char* pv
 326     PREINIT:
 327         I32 i;
 328     PPCODE:
 329         PUTBACK;
 330         require_pv(pv);
 331
 332
 333
 334