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         mPUSHn(-1);
 202         mPUSHn(2);
 203         mPUSHn(-3);
 204         XSRETURN(3);
 205
 206 void
 207 mpushu()
 208         PPCODE:
 209         EXTEND(SP, 3);
 210         mPUSHn(1);
 211         mPUSHn(2);
 212         mPUSHn(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         mXPUSHn(-1);
 235         mXPUSHn(2);
 236         mXPUSHn(-3);
 237         XSRETURN(3);
 238
 239 void
 240 mxpushu()
 241         PPCODE:
 242         mXPUSHn(1);
 243         mXPUSHn(2);
 244         mXPUSHn(3);
 245         XSRETURN(3);