Change the wantarray result from caller from IV to bool for the SCALAR/
[p5sagit/p5-mst-13.2.git] / ext / XS / APItest / APItest.pm
CommitLineData
3e61d65a 1package XS::APItest;
2
3use 5.008;
4use strict;
5use warnings;
6use Carp;
7
8use base qw/ DynaLoader Exporter /;
9
10# Items to export into callers namespace by default. Note: do not export
11# names by default without a very good reason. Use EXPORT_OK instead.
12# Do not simply export all your public functions/methods/constants.
13
14# Export everything since these functions are only used by a test script
deec275f 15our @EXPORT = qw( print_double print_int print_long
9d911683 16 print_float print_long_double have_long_double print_flush
d4b90eee 17 mpushp mpushn mpushi mpushu
18 mxpushp mxpushn mxpushi mxpushu
d1f347d7 19 call_sv call_pv call_method eval_sv eval_pv require_pv
20 G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
21 G_KEEPERR G_NODEBUG G_METHOD
7a646707 22 apitest_exception mycroak strtab
85ce96a1 23 my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv
34482cd6 24 sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
3e61d65a 25);
26
d1f347d7 27# from cop.h
28sub G_SCALAR() { 0 }
29sub G_ARRAY() { 1 }
30sub G_VOID() { 128 }
31sub G_DISCARD() { 2 }
32sub G_EVAL() { 4 }
33sub G_NOARGS() { 8 }
34sub G_KEEPERR() { 16 }
35sub G_NODEBUG() { 32 }
36sub G_METHOD() { 64 }
37
84ac5fd7 38our $VERSION = '0.12';
39
40use vars '$WARNINGS_ON_BOOTSTRAP';
0932863f 41use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
42
9568a123 43BEGIN {
44 # This is arguably a hack, but it disposes of the UNITCHECK block without
45 # needing to preprocess the source code
46 if ($] < 5.009) {
47 eval 'sub UNITCHECK (&) {}; 1' or die $@;
48 }
49}
50
0932863f 51# Do these here to verify that XS code and Perl code get called at the same
52# times
53BEGIN {
54 $BEGIN_called_PP++;
55}
56UNITCHECK {
57 $UNITCHECK_called_PP++;
9568a123 58};
0932863f 59{
60 # Need $W false by default, as some tests run under -w, and under -w we
61 # can get warnings about "Too late to run CHECK" block (and INIT block)
62 no warnings 'void';
63 CHECK {
64 $CHECK_called_PP++;
65 }
66 INIT {
67 $INIT_called_PP++;
68 }
69}
70END {
71 $END_called_PP++;
72}
73
84ac5fd7 74if ($WARNINGS_ON_BOOTSTRAP) {
75 bootstrap XS::APItest $VERSION;
76} else {
0932863f 77 # More CHECK and INIT blocks that could warn:
84ac5fd7 78 local $^W;
84ac5fd7 79 bootstrap XS::APItest $VERSION;
80}
3e61d65a 81
821;
83__END__
84
85=head1 NAME
86
87XS::APItest - Test the perl C API
88
89=head1 SYNOPSIS
90
91 use XS::APItest;
92 print_double(4);
93
94=head1 ABSTRACT
95
96This module tests the perl C API. Currently tests that C<printf>
97works correctly.
98
99=head1 DESCRIPTION
100
101This module can be used to check that the perl C API is behaving
102correctly. This module provides test functions and an associated
103test script that verifies the output.
104
105This module is not meant to be installed.
106
107=head2 EXPORT
108
109Exports all the test functions:
110
111=over 4
112
113=item B<print_double>
114
115Test that a double-precision floating point number is formatted
116correctly by C<printf>.
117
118 print_double( $val );
119
120Output is sent to STDOUT.
121
122=item B<print_long_double>
123
124Test that a C<long double> is formatted correctly by
125C<printf>. Takes no arguments - the test value is hard-wired
126into the function (as "7").
127
128 print_long_double();
129
130Output is sent to STDOUT.
131
132=item B<have_long_double>
133
134Determine whether a C<long double> is supported by Perl. This should
135be used to determine whether to test C<print_long_double>.
136
137 print_long_double() if have_long_double;
138
139=item B<print_nv>
140
141Test that an C<NV> is formatted correctly by
142C<printf>.
143
144 print_nv( $val );
145
146Output is sent to STDOUT.
147
148=item B<print_iv>
149
150Test that an C<IV> is formatted correctly by
151C<printf>.
152
153 print_iv( $val );
154
155Output is sent to STDOUT.
156
157=item B<print_uv>
158
159Test that an C<UV> is formatted correctly by
160C<printf>.
161
162 print_uv( $val );
163
164Output is sent to STDOUT.
165
166=item B<print_int>
167
168Test that an C<int> is formatted correctly by
169C<printf>.
170
171 print_int( $val );
172
173Output is sent to STDOUT.
174
175=item B<print_long>
176
177Test that an C<long> is formatted correctly by
178C<printf>.
179
180 print_long( $val );
181
182Output is sent to STDOUT.
183
184=item B<print_float>
185
186Test that a single-precision floating point number is formatted
187correctly by C<printf>.
188
189 print_float( $val );
190
191Output is sent to STDOUT.
192
d1f347d7 193=item B<call_sv>, B<call_pv>, B<call_method>
194
195These exercise the C calls of the same names. Everything after the flags
196arg is passed as the the args to the called function. They return whatever
197the C function itself pushed onto the stack, plus the return value from
198the function; for example
199
200 call_sv( sub { @_, 'c' }, G_ARRAY, 'a', 'b'); # returns 'a', 'b', 'c', 3
201 call_sv( sub { @_ }, G_SCALAR, 'a', 'b'); # returns 'b', 1
202
203=item B<eval_sv>
204
3c4b39be 205Evaluates the passed SV. Result handling is done the same as for
d1f347d7 206C<call_sv()> etc.
207
208=item B<eval_pv>
209
3c4b39be 210Exercises the C function of the same name in scalar context. Returns the
d1f347d7 211same SV that the C function returns.
212
213=item B<require_pv>
214
3c4b39be 215Exercises the C function of the same name. Returns nothing.
d1f347d7 216
3e61d65a 217=back
218
219=head1 SEE ALSO
220
221L<XS::Typemap>, L<perlapi>.
222
223=head1 AUTHORS
224
225Tim Jenness, E<lt>t.jenness@jach.hawaii.eduE<gt>,
226Christian Soeller, E<lt>csoelle@mph.auckland.ac.nzE<gt>,
227Hugo van der Sanden E<lt>hv@crypt.compulink.co.ukE<gt>
228
229=head1 COPYRIGHT AND LICENSE
230
d1f347d7 231Copyright (C) 2002,2004 Tim Jenness, Christian Soeller, Hugo van der Sanden.
3e61d65a 232All Rights Reserved.
233
234This library is free software; you can redistribute it and/or modify
235it under the same terms as Perl itself.
236
237=cut