Remove Win32 compiler warnings

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

diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index a24e7fb..02a1694 100644 (file)
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -2,6 +2,123 @@
 #include "perl.h"
 #include "XSUB.h"
 
+
+MODULE = XS::APItest:Hash              PACKAGE = XS::APItest::Hash
+
+#define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)
+
+bool
+exists(hash, key_sv)
+       PREINIT:
+       STRLEN len;
+       const char *key;
+       INPUT:
+       HV *hash
+       SV *key_sv
+       CODE:
+       key = SvPV(key_sv, len);
+       RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
+        OUTPUT:
+        RETVAL
+
+SV *
+delete(hash, key_sv)
+       PREINIT:
+       STRLEN len;
+       const char *key;
+       INPUT:
+       HV *hash
+       SV *key_sv
+       CODE:
+       key = SvPV(key_sv, len);
+       /* It's already mortal, so need to increase reference count.  */
+       RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
+        OUTPUT:
+        RETVAL
+
+SV *
+store_ent(hash, key, value)
+       PREINIT:
+       SV *copy;
+       HE *result;
+       INPUT:
+       HV *hash
+       SV *key
+       SV *value
+       CODE:
+       copy = newSV(0);
+       result = hv_store_ent(hash, key, copy, 0);
+       SvSetMagicSV(copy, value);
+       if (!result) {
+           SvREFCNT_dec(copy);
+           XSRETURN_EMPTY;
+       }
+       /* It's about to become mortal, so need to increase reference count.
+        */
+       RETVAL = SvREFCNT_inc(HeVAL(result));
+        OUTPUT:
+        RETVAL
+
+
+SV *
+store(hash, key_sv, value)
+       PREINIT:
+       STRLEN len;
+       const char *key;
+       SV *copy;
+       SV **result;
+       INPUT:
+       HV *hash
+       SV *key_sv
+       SV *value
+       CODE:
+       key = SvPV(key_sv, len);
+       copy = newSV(0);
+       result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
+       SvSetMagicSV(copy, value);
+       if (!result) {
+           SvREFCNT_dec(copy);
+           XSRETURN_EMPTY;
+       }
+       /* It's about to become mortal, so need to increase reference count.
+        */
+       RETVAL = SvREFCNT_inc(*result);
+        OUTPUT:
+        RETVAL
+
+
+SV *
+fetch(hash, key_sv)
+       PREINIT:
+       STRLEN len;
+       const char *key;
+       SV **result;
+       INPUT:
+       HV *hash
+       SV *key_sv
+       CODE:
+       key = SvPV(key_sv, len);
+       result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
+       if (!result) {
+           XSRETURN_EMPTY;
+       }
+       /* Force mg_get  */
+       RETVAL = newSVsv(*result);
+        OUTPUT:
+        RETVAL
+=pod
+
+sub TIEHASH  { bless {}, $_[0] }
+sub STORE    { $_[0]->{$_[1]} = $_[2] }
+sub FETCH    { $_[0]->{$_[1]} }
+sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
+sub NEXTKEY  { each %{$_[0]} }
+sub EXISTS   { exists $_[0]->{$_[1]} }
+sub DELETE   { delete $_[0]->{$_[1]} }
+sub CLEAR    { %{$_[0]} = () }
+
+=cut
+
 MODULE = XS::APItest           PACKAGE = XS::APItest
 
 PROTOTYPES: DISABLE
@@ -20,12 +137,14 @@ have_long_double()
 #else
         RETVAL = 0;
 #endif
+        OUTPUT:
+        RETVAL
 
 void
 print_long_double()
         CODE:
 #ifdef HAS_LONG_DOUBLE
-#   if LONG_DOUBLESIZE > DOUBLESIZE
+#   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
         long double val = 7.0;
         printf("%5.3" PERL_PRIfldbl "\n",val);
 #   else
@@ -35,24 +154,6 @@ print_long_double()
 #endif
 
 void
-print_nv(val)
-        NV val
-        CODE:
-        printf("%5.3Vf\n",val);
-
-void
-print_iv(val)
-        IV val
-        CODE:
-        printf("%Vd\n",val);
-
-void
-print_uv(val)
-        UV val
-        CODE:
-        printf("%Vu\n",val);
-
-void
 print_int(val)
         int val
         CODE:
@@ -69,3 +170,8 @@ print_float(val)
         float val
         CODE:
         printf("%5.3f\n",val);
+       
+void
+print_flush()
+       CODE:
+       fflush(stdout);