This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
APItest.xs: Silence compiler warning
[perl5.git] / ext / XS-APItest / APItest.pm
CommitLineData
3e61d65a
JH
1package XS::APItest;
2
45c5a37a 3{ use 5.011001; } # 5.11 is a long long time ago... What gives with this?
3e61d65a
JH
4use strict;
5use warnings;
6use Carp;
7
4e3e027a 8our $VERSION = '1.12';
b7dfc24f 9
b58f046e 10require XSLoader;
3e61d65a
JH
11
12# Export everything since these functions are only used by a test script
e2f1cb34
NC
13# Export subpackages too - in effect, export all their routines into us, then
14# export everything from us.
15sub import {
16 my $package = shift;
17 croak ("Can't export for '$package'") unless $package eq __PACKAGE__;
18 my $exports;
19 @{$exports}{@_} = () if @_;
20
21 my $callpkg = caller;
22
23 my @stashes = ('XS::APItest::', \%XS::APItest::);
24 while (my ($stash_name, $stash) = splice @stashes, 0, 2) {
25 while (my ($sym_name, $glob) = each %$stash) {
26 if ($sym_name =~ /::$/) {
27 # Skip any subpackages that are clearly OO
28 next if *{$glob}{HASH}{'new'};
120b7a08
SM
29 # and any that have AUTOLOAD
30 next if *{$glob}{HASH}{AUTOLOAD};
e2f1cb34
NC
31 push @stashes, "$stash_name$sym_name", *{$glob}{HASH};
32 } elsif (ref $glob eq 'SCALAR' || *{$glob}{CODE}) {
33 if ($exports) {
34 next if !exists $exports->{$sym_name};
35 delete $exports->{$sym_name};
36 }
37 no strict 'refs';
38 *{"$callpkg\::$sym_name"} = \&{"$stash_name$sym_name"};
39 }
40 }
41 }
83f8bb56 42 foreach (keys %{$exports||{}}) {
996b0cb8 43 next unless /\A(?:rpn|calcrpn|stufftest|swaptwostmts|looprest|scopelessblock|stmtasexpr|stmtsasexpr|loopblock|blockasexpr|swaplabel|labelconst|arrayfullexpr|arraylistexpr|arraytermexpr|arrayarithexpr|arrayexprflags|subsignature|DEFSV|with_vars|join_with_space)\z/;
83f8bb56
Z
44 $^H{"XS::APItest/$_"} = 1;
45 delete $exports->{$_};
46 }
e2f1cb34
NC
47 if ($exports) {
48 my @carp = keys %$exports;
49 if (@carp) {
50 croak(join '',
51 (map "\"$_\" is not exported by the $package module\n", sort @carp),
52 "Can't continue after import errors");
53 }
54 }
55}
3e61d65a 56
84ac5fd7 57use vars '$WARNINGS_ON_BOOTSTRAP';
0932863f
NC
58use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
59
9568a123
NC
60BEGIN {
61 # This is arguably a hack, but it disposes of the UNITCHECK block without
62 # needing to preprocess the source code
63 if ($] < 5.009) {
64 eval 'sub UNITCHECK (&) {}; 1' or die $@;
65 }
66}
67
0932863f
NC
68# Do these here to verify that XS code and Perl code get called at the same
69# times
70BEGIN {
71 $BEGIN_called_PP++;
72}
73UNITCHECK {
74 $UNITCHECK_called_PP++;
9568a123 75};
0932863f
NC
76{
77 # Need $W false by default, as some tests run under -w, and under -w we
78 # can get warnings about "Too late to run CHECK" block (and INIT block)
79 no warnings 'void';
80 CHECK {
81 $CHECK_called_PP++;
82 }
83 INIT {
84 $INIT_called_PP++;
85 }
86}
87END {
88 $END_called_PP++;
89}
90
84ac5fd7 91if ($WARNINGS_ON_BOOTSTRAP) {
b58f046e 92 XSLoader::load();
84ac5fd7 93} else {
0932863f 94 # More CHECK and INIT blocks that could warn:
84ac5fd7 95 local $^W;
b58f046e 96 XSLoader::load();
84ac5fd7 97}
3e61d65a 98
fba8e77b
FC
99# This XS function needs the lvalue attr applied.
100eval 'use attributes __PACKAGE__, \\&lv_temp_object, "lvalue"; 1' or die;
101
3e61d65a
JH
1021;
103__END__
104
105=head1 NAME
106
107XS::APItest - Test the perl C API
108
109=head1 SYNOPSIS
110
111 use XS::APItest;
112 print_double(4);
113
83f8bb56
Z
114 use XS::APItest qw(rpn calcrpn);
115 $triangle = rpn($n $n 1 + * 2 /);
116 calcrpn $triangle { $n $n 1 + * 2 / }
117
3e61d65a
JH
118=head1 ABSTRACT
119
d97c33b5
DM
120This module tests the perl C API. Also exposes various bit of the perl
121internals for the use of core test scripts.
3e61d65a
JH
122
123=head1 DESCRIPTION
124
125This module can be used to check that the perl C API is behaving
126correctly. This module provides test functions and an associated
127test script that verifies the output.
128
129This module is not meant to be installed.
130
131=head2 EXPORT
132
133Exports all the test functions:
134
135=over 4
136
137=item B<print_double>
138
139Test that a double-precision floating point number is formatted
140correctly by C<printf>.
141
142 print_double( $val );
143
144Output is sent to STDOUT.
145
146=item B<print_long_double>
147
148Test that a C<long double> is formatted correctly by
149C<printf>. Takes no arguments - the test value is hard-wired
150into the function (as "7").
151
152 print_long_double();
153
154Output is sent to STDOUT.
155
156=item B<have_long_double>
157
158Determine whether a C<long double> is supported by Perl. This should
159be used to determine whether to test C<print_long_double>.
160
161 print_long_double() if have_long_double;
162
163=item B<print_nv>
164
165Test that an C<NV> is formatted correctly by
166C<printf>.
167
168 print_nv( $val );
169
170Output is sent to STDOUT.
171
172=item B<print_iv>
173
174Test that an C<IV> is formatted correctly by
175C<printf>.
176
177 print_iv( $val );
178
179Output is sent to STDOUT.
180
181=item B<print_uv>
182
183Test that an C<UV> is formatted correctly by
184C<printf>.
185
186 print_uv( $val );
187
188Output is sent to STDOUT.
189
190=item B<print_int>
191
192Test that an C<int> is formatted correctly by
193C<printf>.
194
195 print_int( $val );
196
197Output is sent to STDOUT.
198
199=item B<print_long>
200
201Test that an C<long> is formatted correctly by
202C<printf>.
203
204 print_long( $val );
205
206Output is sent to STDOUT.
207
208=item B<print_float>
209
210Test that a single-precision floating point number is formatted
211correctly by C<printf>.
212
213 print_float( $val );
214
215Output is sent to STDOUT.
216
27fcb6ee
FC
217=item B<filter>
218
219Installs a source filter that substitutes "e" for "o" (witheut regard fer
220what it might be medifying).
221
d1f347d7
DM
222=item B<call_sv>, B<call_pv>, B<call_method>
223
224These exercise the C calls of the same names. Everything after the flags
04a9cc25 225arg is passed as the args to the called function. They return whatever
d1f347d7
DM
226the C function itself pushed onto the stack, plus the return value from
227the function; for example
228
555bd962
BG
229 call_sv( sub { @_, 'c' }, G_ARRAY, 'a', 'b');
230 # returns 'a', 'b', 'c', 3
231 call_sv( sub { @_ }, G_SCALAR, 'a', 'b');
232 # returns 'b', 1
d1f347d7
DM
233
234=item B<eval_sv>
235
3c4b39be 236Evaluates the passed SV. Result handling is done the same as for
d1f347d7
DM
237C<call_sv()> etc.
238
239=item B<eval_pv>
240
3c4b39be 241Exercises the C function of the same name in scalar context. Returns the
d1f347d7
DM
242same SV that the C function returns.
243
244=item B<require_pv>
245
3c4b39be 246Exercises the C function of the same name. Returns nothing.
d1f347d7 247
3e61d65a
JH
248=back
249
83f8bb56
Z
250=head1 KEYWORDS
251
252These are not supplied by default, but must be explicitly imported.
253They are lexically scoped.
254
255=over
256
ce409cc8
LM
257=item DEFSV
258
259Behaves like C<$_>.
260
83f8bb56
Z
261=item rpn(EXPRESSION)
262
263This construct is a Perl expression. I<EXPRESSION> must be an RPN
264arithmetic expression, as described below. The RPN expression is
265evaluated, and its value is returned as the value of the Perl expression.
266
267=item calcrpn VARIABLE { EXPRESSION }
268
269This construct is a complete Perl statement. (No semicolon should
270follow the closing brace.) I<VARIABLE> must be a Perl scalar C<my>
271variable, and I<EXPRESSION> must be an RPN arithmetic expression as
272described below. The RPN expression is evaluated, and its value is
273assigned to the variable.
274
275=back
276
277=head2 RPN expression syntax
278
279Tokens of an RPN expression may be separated by whitespace, but such
280separation is usually not required. It is required only where unseparated
281tokens would look like a longer token. For example, C<12 34 +> can be
282written as C<12 34+>, but not as C<1234 +>.
283
284An RPN expression may be any of:
285
286=over
287
288=item C<1234>
289
290A sequence of digits is an unsigned decimal literal number.
291
292=item C<$foo>
293
294An alphanumeric name preceded by dollar sign refers to a Perl scalar
295variable. Only variables declared with C<my> or C<state> are supported.
296If the variable's value is not a native integer, it will be converted
297to an integer, by Perl's usual mechanisms, at the time it is evaluated.
298
299=item I<A> I<B> C<+>
300
301Sum of I<A> and I<B>.
302
303=item I<A> I<B> C<->
304
305Difference of I<A> and I<B>, the result of subtracting I<B> from I<A>.
306
307=item I<A> I<B> C<*>
308
309Product of I<A> and I<B>.
310
311=item I<A> I<B> C</>
312
313Quotient when I<A> is divided by I<B>, rounded towards zero.
314Division by zero generates an exception.
315
316=item I<A> I<B> C<%>
317
318Remainder when I<A> is divided by I<B> with the quotient rounded towards zero.
319Division by zero generates an exception.
320
321=back
322
323Because the arithmetic operators all have fixed arity and are postfixed,
324there is no need for operator precedence, nor for a grouping operator
325to override precedence. This is half of the point of RPN.
326
327An RPN expression can also be interpreted in another way, as a sequence
328of operations on a stack, one operation per token. A literal or variable
329token pushes a value onto the stack. A binary operator pulls two items
330off the stack, performs a calculation with them, and pushes the result
331back onto the stack. The stack starts out empty, and at the end of the
332expression there must be exactly one value left on the stack.
333
3e61d65a
JH
334=head1 SEE ALSO
335
336L<XS::Typemap>, L<perlapi>.
337
338=head1 AUTHORS
339
340Tim Jenness, E<lt>t.jenness@jach.hawaii.eduE<gt>,
341Christian Soeller, E<lt>csoelle@mph.auckland.ac.nzE<gt>,
83f8bb56
Z
342Hugo van der Sanden E<lt>hv@crypt.compulink.co.ukE<gt>,
343Andrew Main (Zefram) <zefram@fysh.org>
3e61d65a
JH
344
345=head1 COPYRIGHT AND LICENSE
346
d1f347d7 347Copyright (C) 2002,2004 Tim Jenness, Christian Soeller, Hugo van der Sanden.
3e61d65a
JH
348All Rights Reserved.
349
83f8bb56
Z
350Copyright (C) 2009 Andrew Main (Zefram) <zefram@fysh.org>
351
3e61d65a
JH
352This library is free software; you can redistribute it and/or modify
353it under the same terms as Perl itself.
354
355=cut