8 /* A routine to test hv_delayfree_ent
9 (which itself is tested by testing on hv_free_ent */
11 typedef void (freeent_function)(pTHX_ HV *, register HE *);
14 test_freeent(freeent_function *f) {
17 HV *test_hash = newHV();
24 victim = (HE*)safemalloc(sizeof(HE));
26 /* Storing then deleting something should ensure that a hash entry is
28 hv_store(test_hash, "", 0, &PL_sv_yes, 0);
29 hv_delete(test_hash, "", 0, 0);
31 /* We need to "inline" new_he here as it's static, and the functions we
32 test expect to be able to call del_HE on the HE */
34 croak("PL_he_root is 0");
36 PL_he_root = HeNEXT(victim);
39 victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
41 test_scalar = newSV(0);
42 SvREFCNT_inc(test_scalar);
43 victim->hent_val = test_scalar;
45 /* Need this little game else we free the temps on the return stack. */
46 results[0] = SvREFCNT(test_scalar);
48 results[1] = SvREFCNT(test_scalar);
49 f(aTHX_ test_hash, victim);
50 results[2] = SvREFCNT(test_scalar);
52 results[3] = SvREFCNT(test_scalar);
57 } while (++i < sizeof(results)/sizeof(results[0]));
59 /* Goodbye to our extra reference. */
60 SvREFCNT_dec(test_scalar);
63 MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
65 #define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len)
76 key = SvPV(key_sv, len);
77 RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
90 key = SvPV(key_sv, len);
91 /* It's already mortal, so need to increase reference count. */
92 RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
97 store_ent(hash, key, value)
107 result = hv_store_ent(hash, key, copy, 0);
108 SvSetMagicSV(copy, value);
113 /* It's about to become mortal, so need to increase reference count.
115 RETVAL = SvREFCNT_inc(HeVAL(result));
121 store(hash, key_sv, value)
132 key = SvPV(key_sv, len);
134 result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
135 SvSetMagicSV(copy, value);
140 /* It's about to become mortal, so need to increase reference count.
142 RETVAL = SvREFCNT_inc(*result);
157 key = SvPV(key_sv, len);
158 result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
163 RETVAL = newSVsv(*result);
170 test_freeent(&Perl_hv_free_ent);
174 test_hv_delayfree_ent()
176 test_freeent(&Perl_hv_delayfree_ent);
181 sub TIEHASH { bless {}, $_[0] }
182 sub STORE { $_[0]->{$_[1]} = $_[2] }
183 sub FETCH { $_[0]->{$_[1]} }
184 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
185 sub NEXTKEY { each %{$_[0]} }
186 sub EXISTS { exists $_[0]->{$_[1]} }
187 sub DELETE { delete $_[0]->{$_[1]} }
188 sub CLEAR { %{$_[0]} = () }
192 MODULE = XS::APItest PACKAGE = XS::APItest
200 printf("%5.3f\n",val);
205 #ifdef HAS_LONG_DOUBLE
216 #ifdef HAS_LONG_DOUBLE
217 # if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
218 long double val = 7.0;
219 printf("%5.3" PERL_PRIfldbl "\n",val);
222 printf("%5.3f\n",val);
242 printf("%5.3f\n",val);
319 call_sv(sv, flags, ...)
325 for (i=0; i<items-2; i++)
326 ST(i) = ST(i+2); /* pop first two args */
330 i = call_sv(sv, flags);
333 PUSHs(sv_2mortal(newSViv(i)));
336 call_pv(subname, flags, ...)
342 for (i=0; i<items-2; i++)
343 ST(i) = ST(i+2); /* pop first two args */
347 i = call_pv(subname, flags);
350 PUSHs(sv_2mortal(newSViv(i)));
353 call_method(methname, flags, ...)
359 for (i=0; i<items-2; i++)
360 ST(i) = ST(i+2); /* pop first two args */
364 i = call_method(methname, flags);
367 PUSHs(sv_2mortal(newSViv(i)));
377 i = eval_sv(sv, flags);
380 PUSHs(sv_2mortal(newSViv(i)));
383 eval_pv(p, croak_on_error)
389 PUSHs(eval_pv(p, croak_on_error));
408 Perl_croak(aTHX_ "%s", pv);
413 RETVAL = newRV_inc((SV*)PL_strtab);