ext/XS-APItest/APItest.pm

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