This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make PL_charclass available to modules under Win32
[perl5.git] / ext / XS-APItest / APItest.pm
CommitLineData
3e61d65a
JH
1package XS::APItest;
2
3use 5.008;
4use strict;
5use warnings;
6use Carp;
7
e2f1cb34 8use base 'DynaLoader';
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 }
38 if ($exports) {
39 my @carp = keys %$exports;
40 if (@carp) {
41 croak(join '',
42 (map "\"$_\" is not exported by the $package module\n", sort @carp),
43 "Can't continue after import errors");
44 }
45 }
46}
3e61d65a 47
e2f1cb34 48our $VERSION = '0.22';
84ac5fd7
NC
49
50use vars '$WARNINGS_ON_BOOTSTRAP';
0932863f
NC
51use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
52
9568a123
NC
53BEGIN {
54 # This is arguably a hack, but it disposes of the UNITCHECK block without
55 # needing to preprocess the source code
56 if ($] < 5.009) {
57 eval 'sub UNITCHECK (&) {}; 1' or die $@;
58 }
59}
60
0932863f
NC
61# Do these here to verify that XS code and Perl code get called at the same
62# times
63BEGIN {
64 $BEGIN_called_PP++;
65}
66UNITCHECK {
67 $UNITCHECK_called_PP++;
9568a123 68};
0932863f
NC
69{
70 # Need $W false by default, as some tests run under -w, and under -w we
71 # can get warnings about "Too late to run CHECK" block (and INIT block)
72 no warnings 'void';
73 CHECK {
74 $CHECK_called_PP++;
75 }
76 INIT {
77 $INIT_called_PP++;
78 }
79}
80END {
81 $END_called_PP++;
82}
83
84ac5fd7
NC
84if ($WARNINGS_ON_BOOTSTRAP) {
85 bootstrap XS::APItest $VERSION;
86} else {
0932863f 87 # More CHECK and INIT blocks that could warn:
84ac5fd7 88 local $^W;
84ac5fd7
NC
89 bootstrap XS::APItest $VERSION;
90}
3e61d65a
JH
91
921;
93__END__
94
95=head1 NAME
96
97XS::APItest - Test the perl C API
98
99=head1 SYNOPSIS
100
101 use XS::APItest;
102 print_double(4);
103
104=head1 ABSTRACT
105
d97c33b5
DM
106This module tests the perl C API. Also exposes various bit of the perl
107internals for the use of core test scripts.
3e61d65a
JH
108
109=head1 DESCRIPTION
110
111This module can be used to check that the perl C API is behaving
112correctly. This module provides test functions and an associated
113test script that verifies the output.
114
115This module is not meant to be installed.
116
117=head2 EXPORT
118
119Exports all the test functions:
120
121=over 4
122
123=item B<print_double>
124
125Test that a double-precision floating point number is formatted
126correctly by C<printf>.
127
128 print_double( $val );
129
130Output is sent to STDOUT.
131
132=item B<print_long_double>
133
134Test that a C<long double> is formatted correctly by
135C<printf>. Takes no arguments - the test value is hard-wired
136into the function (as "7").
137
138 print_long_double();
139
140Output is sent to STDOUT.
141
142=item B<have_long_double>
143
144Determine whether a C<long double> is supported by Perl. This should
145be used to determine whether to test C<print_long_double>.
146
147 print_long_double() if have_long_double;
148
149=item B<print_nv>
150
151Test that an C<NV> is formatted correctly by
152C<printf>.
153
154 print_nv( $val );
155
156Output is sent to STDOUT.
157
158=item B<print_iv>
159
160Test that an C<IV> is formatted correctly by
161C<printf>.
162
163 print_iv( $val );
164
165Output is sent to STDOUT.
166
167=item B<print_uv>
168
169Test that an C<UV> is formatted correctly by
170C<printf>.
171
172 print_uv( $val );
173
174Output is sent to STDOUT.
175
176=item B<print_int>
177
178Test that an C<int> is formatted correctly by
179C<printf>.
180
181 print_int( $val );
182
183Output is sent to STDOUT.
184
185=item B<print_long>
186
187Test that an C<long> is formatted correctly by
188C<printf>.
189
190 print_long( $val );
191
192Output is sent to STDOUT.
193
194=item B<print_float>
195
196Test that a single-precision floating point number is formatted
197correctly by C<printf>.
198
199 print_float( $val );
200
201Output is sent to STDOUT.
202
d1f347d7
DM
203=item B<call_sv>, B<call_pv>, B<call_method>
204
205These exercise the C calls of the same names. Everything after the flags
206arg is passed as the the args to the called function. They return whatever
207the C function itself pushed onto the stack, plus the return value from
208the function; for example
209
210 call_sv( sub { @_, 'c' }, G_ARRAY, 'a', 'b'); # returns 'a', 'b', 'c', 3
211 call_sv( sub { @_ }, G_SCALAR, 'a', 'b'); # returns 'b', 1
212
213=item B<eval_sv>
214
3c4b39be 215Evaluates the passed SV. Result handling is done the same as for
d1f347d7
DM
216C<call_sv()> etc.
217
218=item B<eval_pv>
219
3c4b39be 220Exercises the C function of the same name in scalar context. Returns the
d1f347d7
DM
221same SV that the C function returns.
222
223=item B<require_pv>
224
3c4b39be 225Exercises the C function of the same name. Returns nothing.
d1f347d7 226
3e61d65a
JH
227=back
228
229=head1 SEE ALSO
230
231L<XS::Typemap>, L<perlapi>.
232
233=head1 AUTHORS
234
235Tim Jenness, E<lt>t.jenness@jach.hawaii.eduE<gt>,
236Christian Soeller, E<lt>csoelle@mph.auckland.ac.nzE<gt>,
237Hugo van der Sanden E<lt>hv@crypt.compulink.co.ukE<gt>
238
239=head1 COPYRIGHT AND LICENSE
240
d1f347d7 241Copyright (C) 2002,2004 Tim Jenness, Christian Soeller, Hugo van der Sanden.
3e61d65a
JH
242All Rights Reserved.
243
244This library is free software; you can redistribute it and/or modify
245it under the same terms as Perl itself.
246
247=cut