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