diff options
Diffstat (limited to 'ext/Devel/PPPort')
| -rwxr-xr-x | ext/Devel/PPPort/Changes | 18 | ||||
| -rw-r--r-- | ext/Devel/PPPort/MANIFEST | 15 | ||||
| -rw-r--r-- | ext/Devel/PPPort/Makefile.PL | 33 | ||||
| -rw-r--r-- | ext/Devel/PPPort/PPPort.pm | 269 | ||||
| -rw-r--r-- | ext/Devel/PPPort/PPPort.xs (renamed from ext/Devel/PPPort/harness/Harness.xs) | 6 | ||||
| -rw-r--r-- | ext/Devel/PPPort/README | 48 | ||||
| -rw-r--r-- | ext/Devel/PPPort/harness/Harness.pm | 21 | ||||
| -rw-r--r-- | ext/Devel/PPPort/harness/Makefile.PL | 36 | ||||
| -rw-r--r-- | ext/Devel/PPPort/harness/t/test.t | 99 | ||||
| -rw-r--r-- | ext/Devel/PPPort/module2.c (renamed from ext/Devel/PPPort/harness/module2.c) | 2 | ||||
| -rw-r--r-- | ext/Devel/PPPort/module3.c (renamed from ext/Devel/PPPort/harness/module3.c) | 2 | ||||
| -rw-r--r-- | ext/Devel/PPPort/soak | 160 | ||||
| -rw-r--r-- | ext/Devel/PPPort/t/test.t | 99 |
13 files changed, 475 insertions, 333 deletions
diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes new file mode 100755 index 0000000000..d29cc71d41 --- /dev/null +++ b/ext/Devel/PPPort/Changes @@ -0,0 +1,18 @@ + +2.002 - 2nd December 2001 + + * More portability issues in Makefile.PL addresed. + * Merged the Harness sub-module into Devel::PPPort + * More documentation in PPPort.pm + +2.001 + + * Some portability issues in Makefile.PL addresed. + +2.000 + + * Initial port to the perl core. + +1.007 + + * Original version of the module by Kenneth Albanowski. diff --git a/ext/Devel/PPPort/MANIFEST b/ext/Devel/PPPort/MANIFEST index df9710ccda..ce524bc5ad 100644 --- a/ext/Devel/PPPort/MANIFEST +++ b/ext/Devel/PPPort/MANIFEST @@ -1,12 +1,11 @@ -PPPort.pm +Changes MANIFEST Makefile.PL +PPPort.pm +PPPort.xs README -soak TODO -harness/Harness.pm -harness/Harness.xs -harness/module2.c -harness/module3.c -harness/Makefile.PL -harness/t/test.t +module2.c +module3.c +soak +t/test.t diff --git a/ext/Devel/PPPort/Makefile.PL b/ext/Devel/PPPort/Makefile.PL index f67a1f0c2a..cd1217e253 100644 --- a/ext/Devel/PPPort/Makefile.PL +++ b/ext/Devel/PPPort/Makefile.PL @@ -2,11 +2,30 @@ use ExtUtils::MakeMaker; WriteMakefile( - NAME => "Devel::PPPort", - DISTNAME => "Devel-PPPort", - VERSION_FROM => 'PPPort.pm', - - #PM => {'PPPort.pm' => '$(INST_LIBDIR)/PPPort.pm'}, - XSPROTOARG => '-noprototypes', - 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" } + NAME => "Devel::PPPort", + DISTNAME => "Devel-PPPort", + VERSION_FROM=> 'PPPort.pm', + + #PM => {'PPPort.pm' => '$(INST_LIBDIR)/PPPort.pm'}, + OBJECT => 'PPPort$(OBJ_EXT) module2$(OBJ_EXT) module3$(OBJ_EXT)', + XSPROTOARG => '-noprototypes', + 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" }, + 'clean' => { FILES => 'ppport.h'}, ); + +sub MY::postamble { + + my $pmfile = 'PPPort.pm' ; + + my $retval = <<"EOM"; + +ppport.h: $pmfile + \$(PERL) "-I\$(PERL_ARCHLIB)" "-I\$(PERL_LIB)" -e "require qq{$pmfile}; package Devel::PPPort ; sub bootstrap {} ; WriteFile(qq{ppport.h})" + +PPPort.xs module2.c module3.c : ppport.h + \$(TOUCH) \$@ + +EOM + + return $retval; +} diff --git a/ext/Devel/PPPort/PPPort.pm b/ext/Devel/PPPort/PPPort.pm index 5bcabdd177..eef2512fb1 100644 --- a/ext/Devel/PPPort/PPPort.pm +++ b/ext/Devel/PPPort/PPPort.pm @@ -12,12 +12,36 @@ Perl/Pollution/Portability =head1 DESCRIPTION -This modules contains a single function, called C<WriteFile>. It is -used to write a 'C' header file that is used when writing XS modules. The -file contains a series of macros that allow XS modules to be built using -older versions of Perl. - -This module is primarily used by h2xs to write the file F<ppport.h>. +Perl has changed over time, gaining new features, new functions, +increasing its flexibility, and reducing the impact on the C namespace +environment (reduced pollution). The header file, typicaly C<ppport.h>, +written by this module attempts to bring some of the newer Perl +features to older versions of Perl, so that you can worry less about +keeping track of old releases, but users can still reap the benefit. + +Why you should use C<ppport.h> in modern code: so that your code will work +with the widest range of Perl interpreters possible, without significant +additional work. + +Why you should attempt older code to fully use C<ppport.h>: because +the reduced pollution of newer Perl versions is an important thing, so +important that the old polluting ways of original Perl modules will not be +supported very far into the future, and your module will almost certainly +break! By adapting to it now, you'll gained compatibility and a sense of +having done the electronic ecology some good. + +How to use ppport.h: Don't direct the user to download C<Devel::PPPort>, +and don't make C<ppport.h> optional. Rather, just take the most recent +copy of C<ppport.h> that you can find (probably in C<Devel::PPPort> +on CPAN), copy it into your project, adjust your project to use it, +and distribute the header along with your module. + +C<Devel::PPPort> contains a single function, called C<WriteFile>. It's +purpose is to write a 'C' header file that is used when writing XS +modules. The file contains a series of macros that allow XS modules to +be built using older versions of Perl. + +This module is used by h2xs to write the file F<ppport.h>. =head2 WriteFile @@ -28,6 +52,61 @@ parameters, it defults to the filename C<./pport.h>. The function returns TRUE if the file was written successfully. Otherwise it returns FALSE. +=head1 ppport.h + +The file written by this module, typically C<ppport.h>, provides access +to the following Perl API if not already available: + + DEFSV + ERRSV + INT2PTR(any,d) + MY_CXT + MY_CXT_INIT + NOOP + PERL_REVISION + PERL_SUBVERSION + PERL_UNUSED_DECL + PERL_VERSION + PL_Sv + PL_compiling + PL_copline + PL_curcop + PL_curstash + PL_defgv + PL_dirty + PL_hints + PL_na + PL_perldb + PL_rsfp_filters + PL_rsfpv + PL_stdingv + PL_sv_no + PL_sv_undef + PL_sv_yes + PTR2IV(d) + SAVE_DEFSV + START_MY_CXT + _aMY_CXT + _pMY_CXT + aMY_CXT + aMY_CXT_ + aTHX + aTHX_ + boolSV(b) + dMY_CXT + dMY_CXT_SV + dNOOP + dTHR + gv_stashpvn(str,len,flags) + newCONSTSUB(stash,name,sv) + newRV_inc(sv) + newRV_noinc(sv) + newSVpvn(data,len) + pMY_CXT + pMY_CXT_ + pTHX + pTHX_ + =head1 AUTHOR Version 1.x of Devel::PPPort was written by Kenneth Albanowski. @@ -40,11 +119,25 @@ See L<h2xs>. =cut + +package Devel::PPPort; + +require Exporter; +require DynaLoader; #use warnings; use strict; -use vars qw( $VERSION $data ); +use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data ); + +$VERSION = "2.0002"; + +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw(); +# Other items we are prepared to export if requested +@EXPORT_OK = qw( ); -$VERSION = "2.0001"; +bootstrap Devel::PPPort; + +package Devel::PPPort; { local $/ = undef; @@ -70,64 +163,84 @@ sub WriteFile 1; __DATA__; -/* Perl/Pollution/Portability Version __VERSION__ */ - -/* Automatically Created by __PKG__ on __DATE__ */ - -/* Do NOT edit this file directly! -- edit PPPort.pm instead. */ - - -#ifndef _P_P_PORTABILITY_H_ -#define _P_P_PORTABILITY_H_ - -/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and - distributed under the same license as any version of Perl. */ - -/* For the latest version of this code, please retreive the Devel::PPPort - module from CPAN, contact the author at <kjahds@kjahds.com>, or check - with the Perl maintainers. */ - -/* If you needed to customize this file for your project, please mention - your changes, and visible alter the version number. */ +/* ppport.h -- Perl/Pollution/Portability Version __VERSION__ + * + * Automatically Created by __PKG__ on __DATE__ + * + * Do NOT edit this file directly! -- Edit PPPort.pm instead. + * + * Version 2.x, Copyright (C) 2001, Paul Marquess. + * Version 1.x, Copyright (C) 1999, Kenneth Albanowski. + * This code may be used and distributed under the same license as any + * version of Perl. + * + * This version of ppport.h is designed to support operation with Perl + * installations back to 5.004, and has been tested up to 5.8.0. + * + * If this version of ppport.h is failing during the compilation of this + * module, please check if a newer version of Devel::PPPort is available + * on CPAN before sending a bug report. + * + * If you are using the latest version of Devel::PPPort and it is failing + * during compilation of this module, please send a report to perlbug@perl.com + * + * Include all following information: + * + * 1. The complete output from running "perl -V" + * + * 2. This file. + * + * 3. The name & version of the module you were trying to build. + * + * 4. A full log of the build that failed. + * + * 5. Any other information that you think could be relevant. + * + * + * For the latest version of this code, please retreive the Devel::PPPort + * module from CPAN. + * + */ /* - In order for a Perl extension module to be as portable as possible - across differing versions of Perl itself, certain steps need to be taken. - Including this header is the first major one, then using dTHR is all the - appropriate places and using a PL_ prefix to refer to global Perl - variables is the second. -*/ + * In order for a Perl extension module to be as portable as possible + * across differing versions of Perl itself, certain steps need to be taken. + * Including this header is the first major one, then using dTHR is all the + * appropriate places and using a PL_ prefix to refer to global Perl + * variables is the second. + * + */ /* If you use one of a few functions that were not present in earlier - versions of Perl, please add a define before the inclusion of ppport.h - for a static include, or use the GLOBAL request in a single module to - produce a global definition that can be referenced from the other - modules. - - Function: Static define: Extern define: - newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL - -*/ + * versions of Perl, please add a define before the inclusion of ppport.h + * for a static include, or use the GLOBAL request in a single module to + * produce a global definition that can be referenced from the other + * modules. + * + * Function: Static define: Extern define: + * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL + * + */ /* To verify whether ppport.h is needed for your module, and whether any - special defines should be used, ppport.h can be run through Perl to check - your source code. Simply say: - - perl -x ppport.h *.c *.h *.xs foo/*.c [etc] - - The result will be a list of patches suggesting changes that should at - least be acceptable, if not necessarily the most efficient solution, or a - fix for all possible problems. It won't catch where dTHR is needed, and - doesn't attempt to account for global macro or function definitions, - nested includes, typemaps, etc. - - In order to test for the need of dTHR, please try your module under a - recent version of Perl that has threading compiled-in. - -*/ + * special defines should be used, ppport.h can be run through Perl to check + * your source code. Simply say: + * + * perl -x ppport.h *.c *.h *.xs foo/*.c [etc] + * + * The result will be a list of patches suggesting changes that should at + * least be acceptable, if not necessarily the most efficient solution, or a + * fix for all possible problems. It won't catch where dTHR is needed, and + * doesn't attempt to account for global macro or function definitions, + * nested includes, typemaps, etc. + * + * In order to test for the need of dTHR, please try your module under a + * recent version of Perl that has threading compiled-in. + * + */ /* @@ -217,6 +330,9 @@ foreach $filename (map(glob($_),@ARGV)) { __DATA__ */ +#ifndef _P_P_PORTABILITY_H_ +#define _P_P_PORTABILITY_H_ + #ifndef PERL_REVISION # ifndef __PATCHLEVEL_H_INCLUDED__ # include "patchlevel.h" @@ -233,6 +349,13 @@ __DATA__ #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) +/* It is very unlikely that anyone will try to use this with Perl 6 + (or greater), but who knows. + */ +#if PERL_REVISION != 5 +# error ppport.h only works with Perl version 5 +#endif /* PERL_REVISION != 5 */ + #ifndef ERRSV # define ERRSV perl_get_sv("@",FALSE) #endif @@ -388,6 +511,19 @@ SV *sv; #endif /* newCONSTSUB */ +#ifndef NOOP +# define NOOP (void)0 +#endif + +#ifdef HASATTRIBUTE +# define PERL_UNUSED_DECL __attribute__((unused)) +#else +# define PERL_UNUSED_DECL +#endif + +#ifndef dNOOP +# define dNOOP extern int Perl___notused PERL_UNUSED_DECL +#endif #ifndef START_MY_CXT @@ -418,8 +554,7 @@ SV *sv; * case below uses it to declare the data as static. */ #define START_MY_CXT -#if PERL_REVISION == 5 && \ - (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) +#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) /* Fetches the SV that keeps the per-interpreter data. */ #define dMY_CXT_SV \ SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) @@ -460,19 +595,6 @@ SV *sv; #else /* single interpreter */ -#ifndef NOOP -# define NOOP (void)0 -#endif - -#ifdef HASATTRIBUTE -# define PERL_UNUSED_DECL __attribute__((unused)) -#else -# define PERL_UNUSED_DECL -#endif - -#ifndef dNOOP -# define dNOOP extern int Perl___notused PERL_UNUSED_DECL -#endif #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP @@ -491,5 +613,6 @@ SV *sv; #endif /* START_MY_CXT */ - #endif /* _P_P_PORTABILITY_H_ */ + +/* End of File ppport.h */ diff --git a/ext/Devel/PPPort/harness/Harness.xs b/ext/Devel/PPPort/PPPort.xs index 683475ae9b..b50dab731e 100644 --- a/ext/Devel/PPPort/harness/Harness.xs +++ b/ext/Devel/PPPort/PPPort.xs @@ -8,7 +8,7 @@ /* Global Data */ -#define MY_CXT_KEY "Devel::PPPort::Harness::_guts" XS_VERSION +#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION typedef struct { /* Put Global Data in here */ @@ -19,13 +19,13 @@ START_MY_CXT void test1(void) { - newCONSTSUB(gv_stashpv("Devel::PPPort::Harness", FALSE), "test_value_1", newSViv(1)); + newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1)); } extern void test2(void); extern void test3(void); -MODULE = Devel::PPPort::Harness PACKAGE = Devel::PPPort::Harness +MODULE = Devel::PPPort PACKAGE = Devel::PPPort BOOT: { diff --git a/ext/Devel/PPPort/README b/ext/Devel/PPPort/README index 3828773ef0..dc8cb2ff31 100644 --- a/ext/Devel/PPPort/README +++ b/ext/Devel/PPPort/README @@ -1,44 +1,14 @@ Perl/Pollution/Portability Version 1.0005 - Copyright (C) 1999, Kenneth Albanowski. This archive may be used and - distributed under the same license as any version of Perl. + Copyright (C) 2001, Paul Marquess. + Copyright (C) 1999, Kenneth Albanowski. + This archive may be used and distributed under the same license as any + version of Perl. - This is not an actual Perl module, but rather a distribution containing a - small header file designed to aid the portability of the XS modules you - write. The Makefile.PL is provided primarily to aid in testing the code. - (Please notify me about any compile warnings or errors, or test failures.) - - Perl has changed over time, gaining new features, new functions, increasing - its flexibility, and reducing the impact on the C namespace environment - (reduced pollution). This header attempts to bring some of the newer Perl - features to older versions of Perl, so that you can worry less about - keeping track of old releases, but users can still reap the benefit. - - Why you should use ppport.h in modern code: so that your code will work - with the widest range of Perl interpreters possible, without significant - additional work. - - Why you should attempt older code to fully use ppport.h: because the - reduced pollution of newer Perl versions is an important thing, so - important that the old polluting ways of original Perl modules will not be - supported very far into the future, and your module will almost certainly - break! By adapting to it now, you'll gained compatibility and a sense of - having done the electronic ecology some good. - +This module is used to create a 'C' header file that can be used by XS +authors. It allows XS module authors to use the latest version of the +Perl API, but still allow their module to be built with older versions +of Perl. - How to use ppport.h: Don't direct the user to download Devel::PPPort, and - don't make ppport.h optional. Rather, just take the most recent copy of - ppport.h that you can find (probably in Devel::PPPort on CPAN), copy it - into your project, adjust your project to use it, and distribute the header - along with your module. - - The file may be able to help you make use of itself. It's got some internal - documentation, and even an automated script to determine how it could be - used. However, ppport.h is a work in progress, and may not include every - feature or macro definition. Feel free to add missing parts, just make sure - to adjust the version mark so that its clear you've branched from the - original version. - - - Kenneth Albanowski <kjahds@kjahds.com>, - February, 1999 +For more details see PPPort.pm. diff --git a/ext/Devel/PPPort/harness/Harness.pm b/ext/Devel/PPPort/harness/Harness.pm deleted file mode 100644 index 365fdfecf6..0000000000 --- a/ext/Devel/PPPort/harness/Harness.pm +++ /dev/null @@ -1,21 +0,0 @@ - -package Devel::PPPort::Harness; - -require Exporter; -require DynaLoader; -use Carp; -use strict; -use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data ); - -$VERSION = "2.0000"; - -@ISA = qw(Exporter DynaLoader); -@EXPORT = qw(); -# Other items we are prepared to export if requested -@EXPORT_OK = qw( ); - -bootstrap Devel::PPPort::Harness; - -package Devel::PPPort::Harness; - -1; diff --git a/ext/Devel/PPPort/harness/Makefile.PL b/ext/Devel/PPPort/harness/Makefile.PL deleted file mode 100644 index 8b23eb5f00..0000000000 --- a/ext/Devel/PPPort/harness/Makefile.PL +++ /dev/null @@ -1,36 +0,0 @@ - -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => "Devel::PPPort::Harness", - VERSION_FROM=> 'Harness.pm', - XSPROTOARG => '-noprototypes', - OBJECT => 'Harness$(OBJ_EXT) module2$(OBJ_EXT) module3$(OBJ_EXT)', - 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" }, - 'clean' => { FILES => 'ppport.h'}, - -); - -sub MY::postamble { - - my $pmfile; - - if ($^O eq 'VMS') { - $pmfile = '[-]PPPort.pm'; - } - else { - $pmfile = '../PPPort.pm'; - } - - my $retval = <<"EOM"; - -ppport.h: $pmfile - \$(PERL) "-I\$(PERL_ARCHLIB)" "-I\$(PERL_LIB)" -e "require qq{$pmfile}; Devel::PPPort::WriteFile(qq{ppport.h})" - -Harness.xs module2.c module3.c : ppport.h - \$(TOUCH) \$@ - -EOM - - return $retval; -} diff --git a/ext/Devel/PPPort/harness/t/test.t b/ext/Devel/PPPort/harness/t/test.t deleted file mode 100644 index 315e611fdf..0000000000 --- a/ext/Devel/PPPort/harness/t/test.t +++ /dev/null @@ -1,99 +0,0 @@ - -use Devel::PPPort::Harness; - -use strict; - -print "1..17\n"; - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib' if -d '../lib'; - -} - -my $total = 0; -my $good = 0; - -my $test = 0; -sub ok { - my ($name, $test_sub) = @_; - my $line = (caller)[2]; - my $value; - - eval { $value = &{ $test_sub }() } ; - - ++ $test ; - - if ($@) { - printf "not ok $test # Testing '$name', line $line $@\n"; - } - elsif ($value != 1){ - printf "not ok $test # Testing '$name', line $line, value != 1 ($value)\n"; - } - else { - print "ok $test\n"; - } - -} - -ok "Static newCONSTSUB()", - sub { Devel::PPPort::Harness::test1(); Devel::PPPort::Harness::test_value_1() == 1} ; - -ok "Global newCONSTSUB()", - sub { Devel::PPPort::Harness::test2(); Devel::PPPort::Harness::test_value_2() == 2} ; - -ok "Extern newCONSTSUB()", - sub { Devel::PPPort::Harness::test3(); Devel::PPPort::Harness::test_value_3() == 3} ; - -ok "newRV_inc()", sub { Devel::PPPort::Harness::test4()} ; - -ok "newRV_noinc()", sub { Devel::PPPort::Harness::test5()} ; - -ok "PL_sv_undef", sub { not defined Devel::PPPort::Harness::test6()} ; - -ok "PL_sv_yes", sub { Devel::PPPort::Harness::test7()} ; - -ok "PL_sv_no", sub { !Devel::PPPort::Harness::test8()} ; - -ok "PL_na", sub { Devel::PPPort::Harness::test9("abcd") == 4} ; - -ok "boolSV 1", sub { Devel::PPPort::Harness::test10(1) } ; - -ok "boolSV 0", sub { ! Devel::PPPort::Harness::test10(0) } ; - -ok "newSVpvn", sub { Devel::PPPort::Harness::test11("abcde", 3) eq "abc" } ; - -ok "DEFSV", sub { $_ = "Fred"; Devel::PPPort::Harness::test12() eq "Fred" } ; - -ok "ERRSV", sub { eval { 1; }; ! Devel::PPPort::Harness::test13() }; - -ok "ERRSV", sub { eval { fred() }; Devel::PPPort::Harness::test13() }; - -ok "CXT 1", sub { Devel::PPPort::Harness::test14()} ; - -ok "CXT 2", sub { Devel::PPPort::Harness::test15()} ; - -__END__ -# TODO - -PERL_VERSION -PERL_BCDVERSION - -PL_stdingv -PL_hints -PL_curcop -PL_curstash -PL_copline -PL_Sv -PL_compiling -PL_dirty - -PTR2IV -INT2PTR - -dTHR -gv_stashpvn -NOOP -SAVE_DEFSV -PERL_UNUSED_DECL -dNOOP diff --git a/ext/Devel/PPPort/harness/module2.c b/ext/Devel/PPPort/module2.c index c1907ba88d..b0778a78a8 100644 --- a/ext/Devel/PPPort/harness/module2.c +++ b/ext/Devel/PPPort/module2.c @@ -8,5 +8,5 @@ void test2(void) { - newCONSTSUB(gv_stashpv("Devel::PPPort::Harness", FALSE), "test_value_2", newSViv(2)); + newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_2", newSViv(2)); } diff --git a/ext/Devel/PPPort/harness/module3.c b/ext/Devel/PPPort/module3.c index ae0be83dee..bf8fad56ad 100644 --- a/ext/Devel/PPPort/harness/module3.c +++ b/ext/Devel/PPPort/module3.c @@ -7,5 +7,5 @@ void test3(void) { - newCONSTSUB(gv_stashpv("Devel::PPPort::Harness", FALSE), "test_value_3", newSViv(3)); + newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_3", newSViv(3)); } diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak index 35afd320df..5ff5b41c9d 100644 --- a/ext/Devel/PPPort/soak +++ b/ext/Devel/PPPort/soak @@ -1,56 +1,41 @@ +# soak: Test Devel::PPPort with multiple versions of Perl. +# +# Author: Paul Marquess +# + +require 5.006001; use strict ; +use warnings ; use ExtUtils::MakeMaker; +use Getopt::Long; + +my $VERSION = "1.000"; $| = 1 ; my $verbose = 0 ; -# TODO -- Get MM->new to output less MakeMaker progress guff -my $mm = MM->new( { NAME => 'dummy' }); - # TODO -- determine what "make" program to run. my $MAKE = 'make'; +my $result = GetOptions( + "verbose" => \$verbose, + "make=s" => \$MAKE, + ) or Usage(); -# TODO -- need to decide how far back we go. +my @GoodPerls = (); -# find all version of Perl that are available -my @PerlBinaries = qw( - 5.004 - 5.00401 - 5.00402 - 5.00403 - 5.00404 - 5.00405 - 5.005 - 5.00501 - 5.00502 - 5.00503 - 5.6.0 - 5.6.1 - 5.7.0 - 5.7.1 - 5.7.2 - ); +if (@ARGV) + { @GoodPerls = @ARGV } +else + { @GoodPerls = FindPerls() } -print "Searching for Perl binaries...\n" ; -my @GoodPerls = (); my $maxlen = 0; -my @path = $mm->path(); -foreach my $perl (@PerlBinaries) { - # TODO -- find_perl will send a warning to STDOUT if it can't find - # the requested perl, so need to temporarily close STDOUT. - - if (my $abs = $mm->find_perl($perl, ["perl$perl"], [@path], 0)) { - push @GoodPerls, $abs ; - $maxlen = length $abs - if length $abs > $maxlen ; - } +foreach (@GoodPerls) { + $maxlen = length $_ + if length $_ > $maxlen ; } -print "\n\nFound "; -foreach (@GoodPerls) { print "$_\n" } -print "\n\n"; $maxlen += 3 ; # run each through the test harness @@ -83,7 +68,7 @@ foreach my $perl (@GoodPerls) } -print "\n\nPassed with $good of $total versions of Perl.\n"; +print "\n\nPassed with $good of $total versions of Perl.\n\n"; exit $bad ; @@ -93,17 +78,102 @@ sub runit my $cmd = shift ; print "\n Running [$cmd]\n" if $verbose ; - my $file = "/tmp/abc.$$" ; - unlink $file ; my $output = `$cmd 2>&1` ; + $output = "\n" unless defined $output; $output =~ s/^/ /gm; - print " Output\n$output\n" if $verbose || $? ; + print "\n Output\n$output\n" if $verbose || $? ; if ($?) { - return 0 unless $verbose ; - warn " $cmd failed: $?\n" ; - exit ; + warn " Running '$cmd' failed: $?\n" ; + return 0 ; } - unlink $file ; return 1 ; } + +sub Usage +{ + die <<EOM; + +usage: soak [OPT] [perl...] + + OPT + -m make - the name of the make program. Default "make" + -v - verbose + +EOM + +} + +sub FindPerls +{ + # TODO -- need to decide how far back we go. + # TODO -- get list of user releases prior to 5.004 + + # find all version of Perl that are available + my @PerlBinaries = qw( + 5.000 + 5.001 + 5.002 + 5.003 + 5.004 + 5.00401 + 5.00402 + 5.00403 + 5.00404 + 5.00405 + 5.005 + 5.00501 + 5.00502 + 5.00503 + 5.6.0 + 5.6.1 + 5.7.0 + 5.7.1 + 5.7.2 + ); + + print "Searching for Perl binaries...\n" ; + my @GoodPerls = (); + my $maxlen = 0; + my $mm = MM->new( { NAME => 'dummy' }); + my @path = $mm->path(); + + # find_perl will send a warning to STDOUT if it can't find + # the requested perl, so need to temporarily silence STDOUT. + tie(*STDOUT, 'NoSTDOUT'); + + foreach my $perl (@PerlBinaries) { + if (my $abs = $mm->find_perl($perl, ["perl$perl"], [@path], 0)) { + push @GoodPerls, $abs ; + } + } + untie *STDOUT; + + print "\n\nFound\n"; + foreach (@GoodPerls) { print " $_\n" } + print "\n\n"; + + return @GoodPerls; +} + +package NoSTDOUT; + +use Tie::Handle; +our @ISA = qw(Tie::Handle); + +sub TIEHANDLE +{ + my ($class) = @_; + my $buf = ""; + bless \$buf, $class; +} + +sub PRINT +{ + my $self = shift; +} + +sub WRITE +{ + my $self = shift; +} diff --git a/ext/Devel/PPPort/t/test.t b/ext/Devel/PPPort/t/test.t new file mode 100644 index 0000000000..bdac50b3b7 --- /dev/null +++ b/ext/Devel/PPPort/t/test.t @@ -0,0 +1,99 @@ + +use Devel::PPPort; + +use strict; + +print "1..17\n"; + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + +} + +my $total = 0; +my $good = 0; + +my $test = 0; +sub ok { + my ($name, $test_sub) = @_; + my $line = (caller)[2]; + my $value; + + eval { $value = &{ $test_sub }() } ; + + ++ $test ; + + if ($@) { + printf "not ok $test # Testing '$name', line $line $@\n"; + } + elsif ($value != 1){ + printf "not ok $test # Testing '$name', line $line, value != 1 ($value)\n"; + } + else { + print "ok $test\n"; + } + +} + +ok "Static newCONSTSUB()", + sub { Devel::PPPort::test1(); Devel::PPPort::test_value_1() == 1} ; + +ok "Global newCONSTSUB()", + sub { Devel::PPPort::test2(); Devel::PPPort::test_value_2() == 2} ; + +ok "Extern newCONSTSUB()", + sub { Devel::PPPort::test3(); Devel::PPPort::test_value_3() == 3} ; + +ok "newRV_inc()", sub { Devel::PPPort::test4()} ; + +ok "newRV_noinc()", sub { Devel::PPPort::test5()} ; + +ok "PL_sv_undef", sub { not defined Devel::PPPort::test6()} ; + +ok "PL_sv_yes", sub { Devel::PPPort::test7()} ; + +ok "PL_sv_no", sub { !Devel::PPPort::test8()} ; + +ok "PL_na", sub { Devel::PPPort::test9("abcd") == 4} ; + +ok "boolSV 1", sub { Devel::PPPort::test10(1) } ; + +ok "boolSV 0", sub { ! Devel::PPPort::test10(0) } ; + +ok "newSVpvn", sub { Devel::PPPort::test11("abcde", 3) eq "abc" } ; + +ok "DEFSV", sub { $_ = "Fred"; Devel::PPPort::test12() eq "Fred" } ; + +ok "ERRSV", sub { eval { 1; }; ! Devel::PPPort::test13() }; + +ok "ERRSV", sub { eval { fred() }; Devel::PPPort::test13() }; + +ok "CXT 1", sub { Devel::PPPort::test14()} ; + +ok "CXT 2", sub { Devel::PPPort::test15()} ; + +__END__ +# TODO + +PERL_VERSION +PERL_BCDVERSION + +PL_stdingv +PL_hints +PL_curcop +PL_curstash +PL_copline +PL_Sv +PL_compiling +PL_dirty + +PTR2IV +INT2PTR + +dTHR +gv_stashpvn +NOOP +SAVE_DEFSV +PERL_UNUSED_DECL +dNOOP |