summaryrefslogtreecommitdiff
path: root/ext/Devel/PPPort
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-12-03 13:13:02 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-12-03 13:13:02 +0000
commit4428420042d0cf28e95202fca89341c18b3a4b1c (patch)
tree97096c56a2f1a596b861d0fe661180a41e28e9fe /ext/Devel/PPPort
parente6af294ea142137c0361c8ceec9119455b62869b (diff)
downloadperl-4428420042d0cf28e95202fca89341c18b3a4b1c.tar.gz
PPPort update from Paul Marquess.
p4raw-id: //depot/perl@13434
Diffstat (limited to 'ext/Devel/PPPort')
-rwxr-xr-xext/Devel/PPPort/Changes18
-rw-r--r--ext/Devel/PPPort/MANIFEST15
-rw-r--r--ext/Devel/PPPort/Makefile.PL33
-rw-r--r--ext/Devel/PPPort/PPPort.pm269
-rw-r--r--ext/Devel/PPPort/PPPort.xs (renamed from ext/Devel/PPPort/harness/Harness.xs)6
-rw-r--r--ext/Devel/PPPort/README48
-rw-r--r--ext/Devel/PPPort/harness/Harness.pm21
-rw-r--r--ext/Devel/PPPort/harness/Makefile.PL36
-rw-r--r--ext/Devel/PPPort/harness/t/test.t99
-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/soak160
-rw-r--r--ext/Devel/PPPort/t/test.t99
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