This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Accessing unicode keys in tie hashes via hv_exists was broken.
[perl5.git] / ext / XS / APItest / APItest.xs
CommitLineData
3e61d65a
JH
1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
0314122a
NC
5
6MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
7
8bool
9exists(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=pod
23
24sub TIEHASH { bless {}, $_[0] }
25sub STORE { $_[0]->{$_[1]} = $_[2] }
26sub FETCH { $_[0]->{$_[1]} }
27sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
28sub NEXTKEY { each %{$_[0]} }
29sub EXISTS { exists $_[0]->{$_[1]} }
30sub DELETE { delete $_[0]->{$_[1]} }
31sub CLEAR { %{$_[0]} = () }
32
33=cut
34
3e61d65a
JH
35MODULE = XS::APItest PACKAGE = XS::APItest
36
37PROTOTYPES: DISABLE
38
39void
40print_double(val)
41 double val
42 CODE:
43 printf("%5.3f\n",val);
44
45int
46have_long_double()
47 CODE:
48#ifdef HAS_LONG_DOUBLE
49 RETVAL = 1;
50#else
51 RETVAL = 0;
52#endif
cabb36f0
CN
53 OUTPUT:
54 RETVAL
3e61d65a
JH
55
56void
57print_long_double()
58 CODE:
59#ifdef HAS_LONG_DOUBLE
fc0bf671 60# if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
3e61d65a
JH
61 long double val = 7.0;
62 printf("%5.3" PERL_PRIfldbl "\n",val);
63# else
64 double val = 7.0;
65 printf("%5.3f\n",val);
66# endif
67#endif
68
69void
3e61d65a
JH
70print_int(val)
71 int val
72 CODE:
73 printf("%d\n",val);
74
75void
76print_long(val)
77 long val
78 CODE:
79 printf("%ld\n",val);
80
81void
82print_float(val)
83 float val
84 CODE:
85 printf("%5.3f\n",val);
9d911683
NIS
86
87void
88print_flush()
89 CODE:
90 fflush(stdout);