PPPort update from Paul Marquess.
authorJarkko Hietaniemi <jhi@iki.fi>
Mon, 3 Dec 2001 13:13:02 +0000 (13:13 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Mon, 3 Dec 2001 13:13:02 +0000 (13:13 +0000)
p4raw-id: //depot/perl@13434

14 files changed:
MANIFEST
ext/Devel/PPPort/Changes [new file with mode: 0755]
ext/Devel/PPPort/MANIFEST
ext/Devel/PPPort/Makefile.PL
ext/Devel/PPPort/PPPort.pm
ext/Devel/PPPort/PPPort.xs [moved from ext/Devel/PPPort/harness/Harness.xs with 88% similarity]
ext/Devel/PPPort/README
ext/Devel/PPPort/harness/Harness.pm [deleted file]
ext/Devel/PPPort/harness/Makefile.PL [deleted file]
ext/Devel/PPPort/harness/t/test.t [deleted file]
ext/Devel/PPPort/module2.c [moved from ext/Devel/PPPort/harness/module2.c with 60% similarity]
ext/Devel/PPPort/module3.c [moved from ext/Devel/PPPort/harness/module3.c with 53% similarity]
ext/Devel/PPPort/soak
ext/Devel/PPPort/t/test.t [new file with mode: 0644]

index d8fc216..a58e99f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -140,17 +140,16 @@ ext/Devel/Peek/Makefile.PL        Data debugging tool, makefile writer
 ext/Devel/Peek/Peek.pm         Data debugging tool, module and pod
 ext/Devel/Peek/Peek.t          See if Devel::Peek works
 ext/Devel/Peek/Peek.xs         Data debugging tool, externals
-ext/Devel/PPPort/harness/Harness.pm    Devel::PPPort test harness
-ext/Devel/PPPort/harness/Harness.xs    Devel::PPPort test harness
-ext/Devel/PPPort/harness/Makefile.PL   Devel::PPPort::harness makefile writer
-ext/Devel/PPPort/harness/module2.c     Devel::PPPort test file
-ext/Devel/PPPort/harness/module3.c     Devel::PPPort test file
-ext/Devel/PPPort/harness/t/test.t      See if Devel::PPPort works
-ext/Devel/PPPort/MANIFEST      Devel::PPPort Manifest
+ext/Devel/PPPort/Changes       Devel::PPPort changes
 ext/Devel/PPPort/Makefile.PL   Devel::PPPort makefile writer
+ext/Devel/PPPort/MANIFEST      Devel::PPPort Manifest
+ext/Devel/PPPort/module2.c     Devel::PPPort test file
+ext/Devel/PPPort/module3.c     Devel::PPPort test file
 ext/Devel/PPPort/PPPort.pm     Devel::PPPort
+ext/Devel/PPPort/PPPort.xs     Devel::PPPort
 ext/Devel/PPPort/README                Devel::PPPort Readme
 ext/Devel/PPPort/soak                  Test Harness to run Devel::PPPort other Perls
+ext/Devel/PPPort/t/test.t      See if Devel::PPPort works
 ext/Devel/PPPort/TODO          Devel::PPPort Todo
 ext/Digest/MD5/Changes         Digest::MD5 extension changes
 ext/Digest/MD5/hints/irix_6.pl Hints for named architecture
diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes
new file mode 100755 (executable)
index 0000000..d29cc71
--- /dev/null
@@ -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.
index df9710c..ce524bc 100644 (file)
@@ -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
index f67a1f0..cd1217e 100644 (file)
@@ -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;
+}
index 5bcabdd..eef2512 100644 (file)
@@ -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 */
similarity index 88%
rename from ext/Devel/PPPort/harness/Harness.xs
rename to ext/Devel/PPPort/PPPort.xs
index 683475a..b50dab7 100644 (file)
@@ -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:
 {
index 3828773..dc8cb2f 100644 (file)
@@ -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 (file)
index 365fdfe..0000000
+++ /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 (file)
index 8b23eb5..0000000
+++ /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 (file)
index 315e611..0000000
+++ /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
similarity index 60%
rename from ext/Devel/PPPort/harness/module2.c
rename to ext/Devel/PPPort/module2.c
index c1907ba..b0778a7 100644 (file)
@@ -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));
 }
similarity index 53%
rename from ext/Devel/PPPort/harness/module3.c
rename to ext/Devel/PPPort/module3.c
index ae0be83..bf8fad5 100644 (file)
@@ -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));
 }
index 35afd32..5ff5b41 100644 (file)
@@ -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 (file)
index 0000000..bdac50b
--- /dev/null
@@ -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