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