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 bool
   9 exists(hash, key_sv)
  10         PREINIT:
  11         STRLEN len;
  12         const char *key;
  13         INPUT:
  14         HV *hash
  15         SV *key_sv
  16         CODE:
  17         key = SvPV(key_sv, len);
  18         RETVAL = hv_exists(hash, key, SvUTF8(key_sv) ? -len : len);
  19         OUTPUT:
  20         RETVAL
  21
  22 SV *
  23 delete(hash, key_sv)
  24         PREINIT:
  25         STRLEN len;
  26         const char *key;
  27         INPUT:
  28         HV *hash
  29         SV *key_sv
  30         CODE:
  31         key = SvPV(key_sv, len);
  32         /* It's already mortal, so need to increase reference count.  */
  33         RETVAL = SvREFCNT_inc(hv_delete(hash, key,
  34                                         SvUTF8(key_sv) ? -len : len, 0));
  35         OUTPUT:
  36         RETVAL
  37
  38 SV *
  39 store(hash, key_sv, value)
  40         PREINIT:
  41         STRLEN len;
  42         const char *key;
  43         SV *copy;
  44         SV **result;
  45         INPUT:
  46         HV *hash
  47         SV *key_sv
  48         SV *value
  49         CODE:
  50         key = SvPV(key_sv, len);
  51         copy = newSV(0);
  52         result = hv_store(hash, key, SvUTF8(key_sv) ? -len : len, copy, 0);
  53         SvSetMagicSV(*result, value);
  54         if (!result) {
  55             SvREFCNT_dec(copy);
  56             XSRETURN_EMPTY;
  57         }
  58         /* It's about to become mortal, so need to increase reference count.
  59          */
  60         RETVAL = SvREFCNT_inc(*result);
  61         OUTPUT:
  62         RETVAL
  63
  64
  65 SV *
  66 fetch(hash, key_sv)
  67         PREINIT:
  68         STRLEN len;
  69         const char *key;
  70         SV **result;
  71         INPUT:
  72         HV *hash
  73         SV *key_sv
  74         CODE:
  75         key = SvPV(key_sv, len);
  76         result = hv_fetch(hash, key, SvUTF8(key_sv) ? -len : len, 0);
  77         if (!result) {
  78             XSRETURN_EMPTY;
  79         }
  80         /* Force mg_get  */
  81         RETVAL = newSVsv(*result);
  82         OUTPUT:
  83         RETVAL
  84
  85 =pod
  86
  87 sub TIEHASH  { bless {}, $_[0] }
  88 sub STORE    { $_[0]->{$_[1]} = $_[2] }
  89 sub FETCH    { $_[0]->{$_[1]} }
  90 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
  91 sub NEXTKEY  { each %{$_[0]} }
  92 sub EXISTS   { exists $_[0]->{$_[1]} }
  93 sub DELETE   { delete $_[0]->{$_[1]} }
  94 sub CLEAR    { %{$_[0]} = () }
  95
  96 =cut
  97
  98 MODULE = XS::APItest            PACKAGE = XS::APItest
  99
 100 PROTOTYPES: DISABLE
 101
 102 void
 103 print_double(val)
 104         double val
 105         CODE:
 106         printf("%5.3f\n",val);
 107
 108 int
 109 have_long_double()
 110         CODE:
 111 #ifdef HAS_LONG_DOUBLE
 112         RETVAL = 1;
 113 #else
 114         RETVAL = 0;
 115 #endif
 116         OUTPUT:
 117         RETVAL
 118
 119 void
 120 print_long_double()
 121         CODE:
 122 #ifdef HAS_LONG_DOUBLE
 123 #   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
 124         long double val = 7.0;
 125         printf("%5.3" PERL_PRIfldbl "\n",val);
 126 #   else
 127         double val = 7.0;
 128         printf("%5.3f\n",val);
 129 #   endif
 130 #endif
 131
 132 void
 133 print_int(val)
 134         int val
 135         CODE:
 136         printf("%d\n",val);
 137
 138 void
 139 print_long(val)
 140         long val
 141         CODE:
 142         printf("%ld\n",val);
 143
 144 void
 145 print_float(val)
 146         float val
 147         CODE:
 148         printf("%5.3f\n",val);
 149
 150 void
 151 print_flush()
 152         CODE:
 153         fflush(stdout);