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