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