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();
23 /* Storing then deleting something should ensure that a hash entry is
25 hv_store(test_hash, "", 0, &PL_sv_yes, 0);
26 hv_delete(test_hash, "", 0, 0);
28 /* We need to "inline" new_he here as it's static, and the functions we
29 test expect to be able to call del_HE on the HE */
31 croak("PL_he_root is 0");
34 PL_he_root = HeNEXT(victim);
36 victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
38 test_scalar = newSV(0);
39 SvREFCNT_inc(test_scalar);
40 victim->hent_val = test_scalar;
42 /* Need this little game else we free the temps on the return stack. */
43 results[0] = SvREFCNT(test_scalar);
45 results[1] = SvREFCNT(test_scalar);
46 f(aTHX_ test_hash, victim);
47 results[2] = SvREFCNT(test_scalar);
49 results[3] = SvREFCNT(test_scalar);
54 } while (++i < sizeof(results)/sizeof(results[0]));
56 /* Goodbye to our extra reference. */
57 SvREFCNT_dec(test_scalar);
60 MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
62 #define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len)
73 key = SvPV(key_sv, len);
74 RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
87 key = SvPV(key_sv, len);
88 /* It's already mortal, so need to increase reference count. */
89 RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
94 store_ent(hash, key, value)
104 result = hv_store_ent(hash, key, copy, 0);
105 SvSetMagicSV(copy, value);
110 /* It's about to become mortal, so need to increase reference count.
112 RETVAL = SvREFCNT_inc(HeVAL(result));
118 store(hash, key_sv, value)
129 key = SvPV(key_sv, len);
131 result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
132 SvSetMagicSV(copy, value);
137 /* It's about to become mortal, so need to increase reference count.
139 RETVAL = SvREFCNT_inc(*result);
154 key = SvPV(key_sv, len);
155 result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
160 RETVAL = newSVsv(*result);
167 test_freeent(&Perl_hv_free_ent);
171 test_hv_delayfree_ent()
173 test_freeent(&Perl_hv_delayfree_ent);
178 sub TIEHASH { bless {}, $_[0] }
179 sub STORE { $_[0]->{$_[1]} = $_[2] }
180 sub FETCH { $_[0]->{$_[1]} }
181 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
182 sub NEXTKEY { each %{$_[0]} }
183 sub EXISTS { exists $_[0]->{$_[1]} }
184 sub DELETE { delete $_[0]->{$_[1]} }
185 sub CLEAR { %{$_[0]} = () }
189 MODULE = XS::APItest PACKAGE = XS::APItest
197 printf("%5.3f\n",val);
202 #ifdef HAS_LONG_DOUBLE
213 #ifdef HAS_LONG_DOUBLE
214 # if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
215 long double val = 7.0;
216 printf("%5.3" PERL_PRIfldbl "\n",val);
219 printf("%5.3f\n",val);
239 printf("%5.3f\n",val);
316 call_sv(sv, flags, ...)
322 for (i=0; i<items-2; i++)
323 ST(i) = ST(i+2); /* pop first two args */
327 i = call_sv(sv, flags);
330 PUSHs(sv_2mortal(newSViv(i)));
333 call_pv(subname, flags, ...)
339 for (i=0; i<items-2; i++)
340 ST(i) = ST(i+2); /* pop first two args */
344 i = call_pv(subname, flags);
347 PUSHs(sv_2mortal(newSViv(i)));
350 call_method(methname, flags, ...)
356 for (i=0; i<items-2; i++)
357 ST(i) = ST(i+2); /* pop first two args */
361 i = call_method(methname, flags);
364 PUSHs(sv_2mortal(newSViv(i)));
374 i = eval_sv(sv, flags);
377 PUSHs(sv_2mortal(newSViv(i)));
380 eval_pv(p, croak_on_error)
386 PUSHs(eval_pv(p, croak_on_error));
405 Perl_croak(aTHX_ "%s", pv);
410 RETVAL = newRV_inc((SV*)PL_strtab);