diff options
| -rw-r--r-- | MANIFEST | 6 | ||||
| -rw-r--r-- | ext/XS/APItest/APItest.pm | 155 | ||||
| -rw-r--r-- | ext/XS/APItest/APItest.xs | 71 | ||||
| -rw-r--r-- | ext/XS/APItest/MANIFEST | 6 | ||||
| -rw-r--r-- | ext/XS/APItest/Makefile.PL | 19 | ||||
| -rw-r--r-- | ext/XS/APItest/README | 29 | ||||
| -rw-r--r-- | ext/XS/APItest/t/printf.t | 62 | ||||
| -rw-r--r-- | perl.h | 3 |
8 files changed, 349 insertions, 2 deletions
@@ -714,6 +714,12 @@ ext/Unicode/Normalize/t/func.t Unicode::Normalize ext/Unicode/Normalize/t/norm.t Unicode::Normalize ext/Unicode/Normalize/t/test.t Unicode::Normalize ext/util/make_ext Used by Makefile to execute extension Makefiles +ext/XS/APItest/APItest.pm XS::APItest extension +ext/XS/APItest/APItest.xs XS::APItest extension +ext/XS/APItest/MANIFEST XS::APItest extension +ext/XS/APItest/Makefile.PL XS::APItest extension +ext/XS/APItest/README XS::APItest extension +ext/XS/APItest/t/printf.t XS::APItest extension ext/XS/Typemap/Makefile.PL XS::Typemap extension ext/XS/Typemap/README XS::Typemap extension ext/XS/Typemap/stdio.c XS::Typemap extension diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm new file mode 100644 index 0000000000..2a01152437 --- /dev/null +++ b/ext/XS/APItest/APItest.pm @@ -0,0 +1,155 @@ +package XS::APItest; + +use 5.008; +use strict; +use warnings; +use Carp; + +use base qw/ DynaLoader Exporter /; + +# Items to export into callers namespace by default. Note: do not export +# names by default without a very good reason. Use EXPORT_OK instead. +# Do not simply export all your public functions/methods/constants. + +# Export everything since these functions are only used by a test script +our @EXPORT = qw( print_double print_nv print_iv print_int + print_float print_long_double have_long_double + print_uv print_long +); + +our $VERSION = '0.01'; + +bootstrap XS::APItest $VERSION; + +1; +__END__ + +=head1 NAME + +XS::APItest - Test the perl C API + +=head1 SYNOPSIS + + use XS::APItest; + print_double(4); + +=head1 ABSTRACT + +This module tests the perl C API. Currently tests that C<printf> +works correctly. + +=head1 DESCRIPTION + +This module can be used to check that the perl C API is behaving +correctly. This module provides test functions and an associated +test script that verifies the output. + +This module is not meant to be installed. + +=head2 EXPORT + +Exports all the test functions: + +=over 4 + +=item B<print_double> + +Test that a double-precision floating point number is formatted +correctly by C<printf>. + + print_double( $val ); + +Output is sent to STDOUT. + +=item B<print_long_double> + +Test that a C<long double> is formatted correctly by +C<printf>. Takes no arguments - the test value is hard-wired +into the function (as "7"). + + print_long_double(); + +Output is sent to STDOUT. + +=item B<have_long_double> + +Determine whether a C<long double> is supported by Perl. This should +be used to determine whether to test C<print_long_double>. + + print_long_double() if have_long_double; + +=item B<print_nv> + +Test that an C<NV> is formatted correctly by +C<printf>. + + print_nv( $val ); + +Output is sent to STDOUT. + +=item B<print_iv> + +Test that an C<IV> is formatted correctly by +C<printf>. + + print_iv( $val ); + +Output is sent to STDOUT. + +=item B<print_uv> + +Test that an C<UV> is formatted correctly by +C<printf>. + + print_uv( $val ); + +Output is sent to STDOUT. + +=item B<print_int> + +Test that an C<int> is formatted correctly by +C<printf>. + + print_int( $val ); + +Output is sent to STDOUT. + +=item B<print_long> + +Test that an C<long> is formatted correctly by +C<printf>. + + print_long( $val ); + +Output is sent to STDOUT. + +=item B<print_float> + +Test that a single-precision floating point number is formatted +correctly by C<printf>. + + print_float( $val ); + +Output is sent to STDOUT. + +=back + +=head1 SEE ALSO + +L<XS::Typemap>, L<perlapi>. + +=head1 AUTHORS + +Tim Jenness, E<lt>t.jenness@jach.hawaii.eduE<gt>, +Christian Soeller, E<lt>csoelle@mph.auckland.ac.nzE<gt>, +Hugo van der Sanden E<lt>hv@crypt.compulink.co.ukE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002 Tim Jenness, Christian Soeller, Hugo van der Sanden. +All Rights Reserved. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs new file mode 100644 index 0000000000..a24e7fb982 --- /dev/null +++ b/ext/XS/APItest/APItest.xs @@ -0,0 +1,71 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +MODULE = XS::APItest PACKAGE = XS::APItest + +PROTOTYPES: DISABLE + +void +print_double(val) + double val + CODE: + printf("%5.3f\n",val); + +int +have_long_double() + CODE: +#ifdef HAS_LONG_DOUBLE + RETVAL = 1; +#else + RETVAL = 0; +#endif + +void +print_long_double() + CODE: +#ifdef HAS_LONG_DOUBLE +# if LONG_DOUBLESIZE > DOUBLESIZE + long double val = 7.0; + printf("%5.3" PERL_PRIfldbl "\n",val); +# else + double val = 7.0; + printf("%5.3f\n",val); +# endif +#endif + +void +print_nv(val) + NV val + CODE: + printf("%5.3Vf\n",val); + +void +print_iv(val) + IV val + CODE: + printf("%Vd\n",val); + +void +print_uv(val) + UV val + CODE: + printf("%Vu\n",val); + +void +print_int(val) + int val + CODE: + printf("%d\n",val); + +void +print_long(val) + long val + CODE: + printf("%ld\n",val); + +void +print_float(val) + float val + CODE: + printf("%5.3f\n",val); diff --git a/ext/XS/APItest/MANIFEST b/ext/XS/APItest/MANIFEST new file mode 100644 index 0000000000..7a7e094edc --- /dev/null +++ b/ext/XS/APItest/MANIFEST @@ -0,0 +1,6 @@ +Makefile.PL +MANIFEST +README +APItest.pm +APItest.xs +t/printf.t diff --git a/ext/XS/APItest/Makefile.PL b/ext/XS/APItest/Makefile.PL new file mode 100644 index 0000000000..6e6cb496ff --- /dev/null +++ b/ext/XS/APItest/Makefile.PL @@ -0,0 +1,19 @@ +use 5.008; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'XS::APItest', + 'VERSION_FROM' => 'APItest.pm', # finds $VERSION + 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'APItest.pm', # retrieve abstract from module + AUTHOR => 'Tim Jenness <t.jenness@jach.hawaii.edu>, Christian Soeller <csoelle@mph.auckland.ac.nz>, Hugo van der Sanden <hv@crypt.compulink.co.uk>') : ()), + 'LIBS' => [''], # e.g., '-lm' + 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' + 'INC' => '-I.', # e.g., '-I. -I/usr/include/other' + # Un-comment this if you add C files to link with later: + # 'OBJECT' => '$(O_FILES)', # link all the C files too +); + +sub MY::install { "install ::\n" }; diff --git a/ext/XS/APItest/README b/ext/XS/APItest/README new file mode 100644 index 0000000000..dbfc91a1d7 --- /dev/null +++ b/ext/XS/APItest/README @@ -0,0 +1,29 @@ +XS::APItest version 0.01 +======================== + +This module is used to test that the Perl C API is working correctly. +It is not meant to be installed. + +Currently tests that printf formatting works correctly. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +None. + +COPYRIGHT AND LICENCE + +Copyright (C) 2002 Tim Jenness, Christian Soeller and Hugo van der Sanden. +All Rights Reserved. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + diff --git a/ext/XS/APItest/t/printf.t b/ext/XS/APItest/t/printf.t new file mode 100644 index 0000000000..c44c8ab9ac --- /dev/null +++ b/ext/XS/APItest/t/printf.t @@ -0,0 +1,62 @@ +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { + print "1..0 # Skip: XS::APItest was not built\n"; + exit 0; + } +} + +use Test::More tests => 15; + +BEGIN { use_ok('XS::APItest') }; + +######################### + +my $ldok = have_long_double(); + +# first some IO redirection +ok open(my $oldout, ">&STDOUT"), "saving STDOUT"; +ok open(STDOUT, '>', "foo.out"),"redirecting STDOUT"; + +# Allow for it to be removed +END { unlink "foo.out"; }; + +select STDOUT; $| = 1; # make unbuffered + +# Run the printf tests +print_double(5); +print_nv(6); +print_int(3); +print_iv(2); +print_iv(-2); +print_uv(3); +print_long(4); +print_float(4); +print_long_double() if $ldok; # val=7 hardwired + +# Now redirect STDOUT and read from the file +ok open(STDOUT, ">&", $oldout), "restore STDOUT"; +ok open(my $foo, "<foo.out"), "open foo.out"; +print "# Test output by reading from file\n"; +# now test the output +my @output = map { chomp; $_ } <$foo>; +close $foo; +ok @output >= 9, "captured at least nine output lines"; + +is($output[0], "5.000", "print_double"); +is($output[1], "6.000", "print_nv"); +is($output[2], "3", "print_int"); +is($output[3], "2", "print_iv positive"); +is($output[4], "-2", "print_iv negative"); +is($output[5], "3", "print_uv"); +is($output[6], "4", "print_long"); +is($output[7], "4.000", "print_float"); + +SKIP: { + skip "No long doubles", 1 unless $ldok; + is($output[8], "7.000", "print_long_double"); +} + + @@ -3828,9 +3828,8 @@ typedef struct am_table_short AMTS; # define Atoul(s) Strtoul(s, (char **)NULL, 10) #endif -#if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE) +#if !defined(PERLIO_IS_STDIO) /* - * Now we have __attribute__ out of the way * Remap printf */ #undef printf |