Devel::PPPort

Message-ID: <AIEAJICLCBDNAAOLLOKLCECEDGAA.paul_marquess@yahoo.co.uk>

p4raw-id: //depot/perl@13286

11 files changed, 127 insertions, 104 deletions

diff --git a/MANIFEST b/MANIFEST
index 2b8b218548..e7349ea006 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -145,6 +145,7 @@ 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/Makefile.PL	Devel::PPPort makefile writer
 ext/Devel/PPPort/PPPort.pm	Devel::PPPort
 ext/Devel/PPPort/README		Devel::PPPort Readme
diff --git a/ext/Devel/PPPort/MANIFEST b/ext/Devel/PPPort/MANIFEST
new file mode 100644
index 0000000000..df9710ccda
--- /dev/null
+++ b/ext/Devel/PPPort/MANIFEST
@@ -0,0 +1,12 @@
+PPPort.pm
+MANIFEST
+Makefile.PL
+README
+soak
+TODO
+harness/Harness.pm
+harness/Harness.xs
+harness/module2.c
+harness/module3.c
+harness/Makefile.PL
+harness/t/test.t
diff --git a/ext/Devel/PPPort/Makefile.PL b/ext/Devel/PPPort/Makefile.PL
index 14ec479ec0..f67a1f0c2a 100644
--- a/ext/Devel/PPPort/Makefile.PL
+++ b/ext/Devel/PPPort/Makefile.PL
@@ -10,12 +10,3 @@ WriteMakefile(
 	XSPROTOARG => '-noprototypes',
 	'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" }
 );
-
-sub MY::postamble {<<'EOM'};
-
-sweep:
-	cd harness ; $(MAKE) sweep
-	$(RM_F) pm_to_blib
-	$(RM_RF) ./blib
-
-EOM
diff --git a/ext/Devel/PPPort/PPPort.pm b/ext/Devel/PPPort/PPPort.pm
index 1a9c9b2192..5bcabdd177 100644
--- a/ext/Devel/PPPort/PPPort.pm
+++ b/ext/Devel/PPPort/PPPort.pm
@@ -30,9 +30,9 @@ it returns FALSE.
 
 =head1 AUTHOR
 
-Version 1 of Devel::PPPort was written by Kenneth Albanowski.
+Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
 
-Version 2 was ported to the Perl core by Paul Marquess.
+Version 2.x was ported to the Perl core by Paul Marquess.
 
 =head1 SEE ALSO
 
@@ -44,16 +44,16 @@ See L<h2xs>.
 use strict;
 use vars qw( $VERSION $data );
 
-$VERSION = "2.0000";
+$VERSION = "2.0001";
 
 {
     local $/ = undef;
     $data = <DATA> ;
     my $now = localtime;
     my $pkg = __PACKAGE__;
-    $data =~ s/__VERSION__/$VERSION/;
-    $data =~ s/__DATE__/$now/;
-    $data =~ s/__PKG__/$pkg/;
+    $data =~ s/__VERSION__/$VERSION/g;
+    $data =~ s/__DATE__/$now/g;
+    $data =~ s/__PKG__/$pkg/g;
 }
 
 sub WriteFile
diff --git a/ext/Devel/PPPort/harness/Harness.pm b/ext/Devel/PPPort/harness/Harness.pm
index 992ab5a826..365fdfecf6 100644
--- a/ext/Devel/PPPort/harness/Harness.pm
+++ b/ext/Devel/PPPort/harness/Harness.pm
@@ -1,5 +1,5 @@
 
-package Devel::Harness;
+package Devel::PPPort::Harness;
 
 require Exporter;
 require DynaLoader;
@@ -14,8 +14,8 @@ $VERSION = "2.0000";
 # Other items we are prepared to export if requested
 @EXPORT_OK = qw( );
 
-bootstrap Devel::Harness;
+bootstrap Devel::PPPort::Harness;
 
-package Devel::Harness;
+package Devel::PPPort::Harness;
 
 1;
diff --git a/ext/Devel/PPPort/harness/Harness.xs b/ext/Devel/PPPort/harness/Harness.xs
index a8dfd8c4e7..683475ae9b 100644
--- a/ext/Devel/PPPort/harness/Harness.xs
+++ b/ext/Devel/PPPort/harness/Harness.xs
@@ -8,7 +8,7 @@
 
 /* Global Data */
  
-#define MY_CXT_KEY "${module}::_guts" XS_VERSION
+#define MY_CXT_KEY "Devel::PPPort::Harness::_guts" XS_VERSION
  
 typedef struct {
     /* Put Global Data in here */
@@ -19,13 +19,13 @@ START_MY_CXT
 
 void test1(void)
 {
-	newCONSTSUB(gv_stashpv("Devel::Harness", FALSE), "test_value_1", newSViv(1));
+	newCONSTSUB(gv_stashpv("Devel::PPPort::Harness", FALSE), "test_value_1", newSViv(1));
 }
 
 extern void test2(void);
 extern void test3(void);
 
-MODULE = Devel::Harness		PACKAGE = Devel::Harness
+MODULE = Devel::PPPort::Harness		PACKAGE = Devel::PPPort::Harness
 
 BOOT:
 {
diff --git a/ext/Devel/PPPort/harness/Makefile.PL b/ext/Devel/PPPort/harness/Makefile.PL
index 59c6c0cad5..2d513bed84 100644
--- a/ext/Devel/PPPort/harness/Makefile.PL
+++ b/ext/Devel/PPPort/harness/Makefile.PL
@@ -2,8 +2,8 @@
 use ExtUtils::MakeMaker;
 
 WriteMakefile(
-	NAME => "Devel::Harness",
-	VERSION_FROM => '../PPPort.pm',
+	NAME => "Devel::PPPort::Harness",
+	VERSION_FROM => 'Harness.pm',
 	
 	
 	XSPROTOARG => '-noprototypes',
@@ -11,36 +11,32 @@ WriteMakefile(
 	#XS => {'Harness.xs' => 'Harness.c'},
 	OBJECT => 'Harness$(OBJ_EXT) module2$(OBJ_EXT) module3$(OBJ_EXT)',
 	'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" },
+	'clean' => { FILES => 'ppport.h'},
+	'depend' => { 'Harness.c'	=> 'ppport.h',
+		      'module2.c'	=> 'ppport.h',
+		      'module3.c'	=> 'ppport.h',
+		    },
 
 );
 
 sub MY::postamble {
 
-  use File::Spec;
+    my $pmfile;
+    my $Ilibdir = '';
 
-  my $libdir = File::Spec->catdir(File::Spec->updir(), File::Spec->updir(),  
-				  File::Spec->updir(),  File::Spec->updir(),  
-                                  'lib');
-  my $blibdir = File::Spec->catdir(File::Spec->curdir(), 'blib');
-  my $pmfile = File::Spec->catfile(File::Spec->updir(), 'PPPort.pm');
-  my $retval = <<'EOM';
+    if ($^O eq 'VMS') {
+        $pmfile = '[-]PPPort.pm';
+    }
+    else {
+        $pmfile = '../PPPort.pm';
+    }
 
-sweep:
-	$(RM_F) pm_to_blib Harness.c Harness$(OBJ_EXT) module2$(OBJ_EXT) module3$(OBJ_EXT) ppport.h
-EOM
- 
-  $retval .= "\t\$(RM_RF) $blibdir\n\n";
-  $retval .= "Harness.c :      ppport.h\n\n";  
-  $retval .= "module2.c module3.c : ppport.h\n\t\$(NOECHO) \$(NOOP)\n\n";  
-  $retval .= "ppport.h: $pmfile\n";  
-
-  my $Ilibdir = $^O eq 'VMS' ? qq{"-I$libdir"} : qq{-I$libdir};
-
-  $pmfile =~ s:\\:\\\\:g;
+  my $retval = <<"EOM";
 
-  $retval .= qq[\t\$(PERL) $Ilibdir -e "require qq{$pmfile}; Devel::PPPort::WriteFile(qq{ppport.h})"];
+ppport.h:	$pmfile
+	\$(PERL) "-I\$(PERL_ARCHLIB)" "-I\$(PERL_LIB)" -e "require qq{$pmfile}; Devel::PPPort::WriteFile(qq{ppport.h})"     
 
+EOM
+ 
   return $retval;
 }
-
-sub MY::install { "install ::\n"  };
diff --git a/ext/Devel/PPPort/harness/module2.c b/ext/Devel/PPPort/harness/module2.c
index 098338564d..c1907ba88d 100644
--- a/ext/Devel/PPPort/harness/module2.c
+++ b/ext/Devel/PPPort/harness/module2.c
@@ -8,5 +8,5 @@
 
 void test2(void)
 {
-	newCONSTSUB(gv_stashpv("Devel::Harness", FALSE), "test_value_2", newSViv(2));
+	newCONSTSUB(gv_stashpv("Devel::PPPort::Harness", FALSE), "test_value_2", newSViv(2));
 }
diff --git a/ext/Devel/PPPort/harness/module3.c b/ext/Devel/PPPort/harness/module3.c
index 563b3ce614..ae0be83dee 100644
--- a/ext/Devel/PPPort/harness/module3.c
+++ b/ext/Devel/PPPort/harness/module3.c
@@ -7,5 +7,5 @@
 
 void test3(void)
 {
-	newCONSTSUB(gv_stashpv("Devel::Harness", FALSE), "test_value_3", newSViv(3));
+	newCONSTSUB(gv_stashpv("Devel::PPPort::Harness", FALSE), "test_value_3", newSViv(3));
 }
diff --git a/ext/Devel/PPPort/harness/t/test.t b/ext/Devel/PPPort/harness/t/test.t
index ce40035861..315e611fdf 100644
--- a/ext/Devel/PPPort/harness/t/test.t
+++ b/ext/Devel/PPPort/harness/t/test.t
@@ -1,5 +1,5 @@
 
-use Devel::Harness;
+use Devel::PPPort::Harness;
 
 use strict;
 
@@ -37,41 +37,41 @@ sub ok {
 } 
 
 ok "Static newCONSTSUB()", 
-   sub { Devel::Harness::test1(); Devel::Harness::test_value_1() == 1} ;
+   sub { Devel::PPPort::Harness::test1(); Devel::PPPort::Harness::test_value_1() == 1} ;
 
 ok "Global newCONSTSUB()", 
-   sub { Devel::Harness::test2(); Devel::Harness::test_value_2() == 2} ;
+   sub { Devel::PPPort::Harness::test2(); Devel::PPPort::Harness::test_value_2() == 2} ;
 
 ok "Extern newCONSTSUB()", 
-   sub { Devel::Harness::test3(); Devel::Harness::test_value_3() == 3} ;
+   sub { Devel::PPPort::Harness::test3(); Devel::PPPort::Harness::test_value_3() == 3} ;
 
-ok "newRV_inc()", sub { Devel::Harness::test4()} ;
+ok "newRV_inc()", sub { Devel::PPPort::Harness::test4()} ;
 
-ok "newRV_noinc()", sub { Devel::Harness::test5()} ;
+ok "newRV_noinc()", sub { Devel::PPPort::Harness::test5()} ;
 
-ok "PL_sv_undef", sub { not defined Devel::Harness::test6()} ;
+ok "PL_sv_undef", sub { not defined Devel::PPPort::Harness::test6()} ;
 
-ok "PL_sv_yes", sub { Devel::Harness::test7()} ;
+ok "PL_sv_yes", sub { Devel::PPPort::Harness::test7()} ;
 
-ok "PL_sv_no", sub { !Devel::Harness::test8()} ;
+ok "PL_sv_no", sub { !Devel::PPPort::Harness::test8()} ;
 
-ok "PL_na", sub { Devel::Harness::test9("abcd") == 4} ;
+ok "PL_na", sub { Devel::PPPort::Harness::test9("abcd") == 4} ;
 
-ok "boolSV 1", sub { Devel::Harness::test10(1) } ;
+ok "boolSV 1", sub { Devel::PPPort::Harness::test10(1) } ;
 
-ok "boolSV 0", sub { ! Devel::Harness::test10(0) } ;
+ok "boolSV 0", sub { ! Devel::PPPort::Harness::test10(0) } ;
 
-ok "newSVpvn", sub { Devel::Harness::test11("abcde", 3) eq "abc" } ;
+ok "newSVpvn", sub { Devel::PPPort::Harness::test11("abcde", 3) eq "abc" } ;
 
-ok "DEFSV", sub { $_ = "Fred"; Devel::Harness::test12() eq "Fred" } ;
+ok "DEFSV", sub { $_ = "Fred"; Devel::PPPort::Harness::test12() eq "Fred" } ;
 
-ok "ERRSV", sub { eval { 1; }; ! Devel::Harness::test13() };
+ok "ERRSV", sub { eval { 1; }; ! Devel::PPPort::Harness::test13() };
 
-ok "ERRSV", sub { eval { fred() }; Devel::Harness::test13() };
+ok "ERRSV", sub { eval { fred() }; Devel::PPPort::Harness::test13() };
 
-ok "CXT 1", sub { Devel::Harness::test14()} ;
+ok "CXT 1", sub { Devel::PPPort::Harness::test14()} ;
 
-ok "CXT 2", sub { Devel::Harness::test15()} ;
+ok "CXT 2", sub { Devel::PPPort::Harness::test15()} ;
 
 __END__
 # TODO
diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak
index 893f353db7..35afd320df 100644
--- a/ext/Devel/PPPort/soak
+++ b/ext/Devel/PPPort/soak
@@ -1,30 +1,56 @@
 
+
 use strict ;
+use ExtUtils::MakeMaker;
 
+$| = 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';
+
+
+# TODO -- need to decide how far back we go.
+
 # find all version of Perl that are available
 my @PerlBinaries = qw( 
-	perl5.004        
-	perl5.00401      
-	perl5.00402      
-	perl5.00403      
-	perl5.00404      
-	perl5.00405      
-	perl5.005                         
-	perl5.00501                       
-	perl5.00502      
-	perl5.00503                     
-	perl5.6.0        
-	perl5.6.1 
-	perl5.7.0
-	perl5.7.1
-	perl5.7.2      
+	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      
 	);
 
-my $maxlen = 0 ;
-foreach (@PerlBinaries)
-  { $maxlen = length $_ if length $_ > $maxlen }
+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 ;
+    }
+}
+print "\n\nFound ";
+foreach (@GoodPerls) { print "$_\n" }
+print "\n\n";
 $maxlen += 3 ;
 
 # run each through the test harness
@@ -33,21 +59,26 @@ my $bad = 0 ;
 my $good = 0 ;
 my $total = 0 ;
 
-foreach my $perl (@PerlBinaries)
+# prime the pump, so the first "make clean" will work.
+runit("perl Makefile.PL") || die "Cannot run perl Makefile.PL\n" ;
+
+foreach my $perl (@GoodPerls)
 {
+   my $prefix = "$perl -- " if $verbose ;
    print "Testing $perl " . ('.' x ($maxlen - length $perl)) ;
-   my $ok = runit("$perl Makefile.PL") &&
-            runit("make sweep")	&&
-            runit("make test")	;
+
+   my $ok = runit("$MAKE clean") &&
+            runit("$perl Makefile.PL") &&
+            runit("$MAKE test")	;
 
     ++ $total;
     if ($ok) {
         ++ $good ;
-        print "ok\n";
+        print "${prefix}ok\n";
     }
     else {
         ++ $bad ;
-        print "not ok\n" ;
+        print "${prefix}not ok\n" ;
     }
 
 }
@@ -58,29 +89,21 @@ exit $bad ;
 
 sub runit
 {
+    # TODO -- portability alert!!
+
     my $cmd = shift ;
-    print "Running [$cmd]\n" if $verbose ;
+    print "\n    Running [$cmd]\n" if $verbose ;
     my $file = "/tmp/abc.$$" ;
     unlink $file ;
-    system "$cmd >$file 2>&1" ;
+    my $output = `$cmd 2>&1` ;
+    $output =~ s/^/      /gm;
+    print "    Output\n$output\n" if $verbose || $? ;
     if ($?)
     {
         return 0 unless $verbose ;
-        my $output = docat_del($file) ;
-        warn "$cmd failed: $?\n$output\n" ;
+        warn "    $cmd failed: $?\n" ;
         exit ;
     }
     unlink $file ;
     return 1 ;
 }                   
-
-sub docat_del
-{
-    my $file = shift;
-    local $/ = undef;
-    open(CAT, "<$file") || die "Cannot open $file: $!";
-    my $result = <CAT>;
-    close(CAT);
-    unlink $file ;
-    return $result;
-}