[PATCH: perl@11564] introducing perlivp

Date: Sun, 5 Aug 2001 22:00:14 -0700 (PDT)
Message-ID: <Pine.BSF.4.21.0108052155110.7110-100000@shell8.ba.best.com>

Subject: Re: [PATCH: perl@11564] introducing perlivp
From: Prymmer/Kahn <pvhp@best.com>
Date: Sun, 5 Aug 2001 22:32:59 -0700 (PDT)
Message-ID: <Pine.BSF.4.21.0108052229470.9059-100000@shell8.ba.best.com>

p4raw-id: //depot/perl@11594

7 files changed, 483 insertions, 6 deletions

diff --git a/MANIFEST b/MANIFEST
index c51a8df4c6..0a9887f63d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2154,6 +2154,7 @@ utils/Makefile			Extract the utility scripts
 utils/perlbug.PL		A simple tool to submit a bug report
 utils/perlcc.PL			Front-end for compiler
 utils/perldoc.PL		A simple tool to find & display perl's documentation
+utils/perlivp.PL		installation verification procedure
 utils/pl2pm.PL			A pl to pm translator
 utils/splain.PL			Stand-alone version of diagnostics.pm
 uts/sprintf_wrap.c		sprintf wrapper for UTS
diff --git a/utils.lst b/utils.lst
index a5bb8bcf8f..1429ff507b 100644
--- a/utils.lst
+++ b/utils.lst
@@ -14,6 +14,7 @@ utils/libnetcfg
 utils/perlbug
 utils/perlcc
 utils/perldoc
+utils/perlivp
 utils/pl2pm
 utils/splain
 x2p/a2p         # pod = x2p/a2p.pod
diff --git a/utils/Makefile b/utils/Makefile
index 043430aba8..35b8cd7cc1 100644
--- a/utils/Makefile
+++ b/utils/Makefile
@@ -5,9 +5,9 @@ REALPERL = ../perl
 # Files to be built with variable substitution after miniperl is
 # available.  Dependencies handled manually below (for now).
 
-pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL
-plextract  = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc dprofpp libnetcfg
-plextractexe  = ./c2ph ./h2ph ./h2xs ./perlbug ./perldoc ./pl2pm ./splain ./perlcc ./dprofpp ./libnetcfg
+pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL
+plextract  = c2ph h2ph h2xs perlbug perldoc perlivp pl2pm splain perlcc dprofpp libnetcfg
+plextractexe  = ./c2ph ./h2ph ./h2xs ./perlbug ./perldoc ./perlivp ./pl2pm ./splain ./perlcc ./dprofpp ./libnetcfg
 
 all: $(plextract) 
 
@@ -17,6 +17,7 @@ compile: all $(plextract)
 	$(REALPERL) -I../lib perlcc -I .. -L .. h2xs -o h2xs.exe -v 10 -log ../compilelog;
 	$(REALPERL) -I../lib perlcc -I .. -L .. perlbug -o perlbug.exe -v 10 -log ../compilelog;
 	$(REALPERL) -I../lib perlcc -I .. -L .. perldoc -o perldoc.exe -v 10 -log ../compilelog;
+	$(REALPERL) -I../lib perlcc -I .. -L .. perlivp -o perlivp.exe -v 10 -log ../compilelog;
 	$(REALPERL) -I../lib perlcc -I .. -L .. pl2pm -o pl2pm.exe -v 10 -log ../compilelog;
 	$(REALPERL) -I../lib perlcc -I .. -L .. splain -o splain.exe -v 10 -log ../compilelog;
 	$(REALPERL) -I../lib perlcc -I .. -L .. perlcc -I .. -L .. -o perlcc.exe -v 10 -log ../compilelog;
@@ -36,6 +37,8 @@ perlbug:	perlbug.PL ../config.sh ../patchlevel.h
 
 perldoc:	perldoc.PL ../config.sh
 
+perlivp:	perlivp.PL ../config.sh
+
 pl2pm:		pl2pm.PL ../config.sh
 
 splain:		splain.PL ../config.sh ../lib/diagnostics.pm
diff --git a/utils/perlivp.PL b/utils/perlivp.PL
new file mode 100644
index 0000000000..39d7f2a563
--- /dev/null
+++ b/utils/perlivp.PL
@@ -0,0 +1,466 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename;
+use Cwd;
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries:
+#  $startperl
+#  $perlpath
+#  $eunicefix
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
+chdir dirname($0);
+$file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
+
+# Create output file.
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec $Config{'perlpath'} -S \$0 \${1+"\$@"}'
+        if \$running_under_some_shell;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+# perlivp V 0.01
+
+
+sub usage {
+    warn "@_\n" if @_;
+    print << "    EOUSAGE";
+Usage:
+
+    $0 [-p] [-v] | [-h]
+
+    -p Print a preface before each test telling what it will test.
+    -v Verbose mode in which extra information about test results
+       is printed.  Test failures always print out some extra information
+       regardless of whether or not this switch is set.
+    -h Prints this help message.
+    EOUSAGE
+    exit;
+}
+
+use vars (%opt); # allow testing with older versions (do not use our)
+
+@opt{ qw/? H h P p V v/ } = qw(0 0 0 0 0 0 0);
+
+while ($ARGV[0] =~ /^-/) {
+    $ARGV[0] =~ s/^-//; 
+    for my $flag (split(//,$ARGV[0])) {
+        usage() if '?' =~ /\Q$flag/;
+        usage() if 'h' =~ /\Q$flag/;
+        usage() if 'H' =~ /\Q$flag/;
+        usage("unknown flag: `$flag'") unless 'HhPpVv' =~ /\Q$flag/;
+        warn "$0: `$flag' flag already set\n" if $opt{$flag}++;
+    } 
+    shift;
+}
+
+$opt{p}++ if $opt{P};
+$opt{v}++ if $opt{V};
+
+my $pass__total = 0;
+my $error_total = 0;
+my $tests_total = 0;
+
+!NO!SUBS!
+
+# We cannot merely check the variable `$^X' in general since on many 
+# Unixes it is the basename rather than the full path to the perl binary.
+my $perlpath = '';
+if (defined($Config{'perlpath'})) { $perlpath = $Config{'perlpath'}; }
+# Of course some platforms are distinct...
+if ($^O eq 'VMS') { $perlpath = $^X; }
+
+print OUT <<"!GROK!THIS!";
+my \$perlpath = '$perlpath';
+!GROK!THIS!
+
+print OUT <<'!NO!SUBS!';
+
+print "## Checking Perl binary via variable `\$perlpath' = $perlpath.\n" if $opt{'p'};
+
+if (-x $perlpath) {
+    print "## Perl binary `$perlpath' appears executable.\n" if $opt{'v'};
+    print "ok 1\n";
+    $pass__total++;
+}
+else {
+    print "# Perl binary `$perlpath' does not appear executable.\n";
+    print "not ok 1\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking Perl version via variable `\$]'.\n" if $opt{'p'};
+
+!NO!SUBS!
+
+print OUT <<"!GROK!THIS!";
+my \$ivp_VERSION = $];
+
+!GROK!THIS!
+print OUT <<'!NO!SUBS!';
+if ($ivp_VERSION == $]) {
+    print "## Perl version `$]' appears installed as expected.\n" if $opt{'v'};
+    print "ok 2\n";
+    $pass__total++;
+}
+else {
+    print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
+    print "not ok 2\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking roots of the Perl library directory tree via variable `\@INC'.\n" if $opt{'p'};
+
+my $INC_total = 0;
+my $INC_there = 0;
+foreach (@INC) {
+    next if $_ eq '.'; # skip -d test here
+    if ($^O eq 'MacOS') {
+        next if $_ eq ':'; # skip -d test here
+        next if $_ eq 'Dev:Pseudo:'; # why is this in @INC?
+    }
+    if (-d $_) {
+        print "## Perl \@INC directory `$_' exists.\n" if $opt{'v'};
+        $INC_there++;
+    }
+    else {
+        print "# Perl \@INC directory `$_' does not appear to exist.\n";
+    }
+    $INC_total++;
+}
+if ($INC_total == $INC_there) {
+    print "ok 3\n";
+    $pass__total++;
+}
+else {
+    print "not ok 3\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
+
+my $needed_total = 0;
+my $needed_there = 0;
+foreach (qw(Config.pm ExtUtils/Installed.pm)) {
+    $@ = undef;
+    $needed_total++;
+    eval "require \"$_\";";
+    if (!$@) {
+        print "## Module `$_' appears to be installed.\n" if $opt{'v'};
+        $needed_there++;
+    }
+    else {
+        print "# Needed module `$_' does not appear to be properly installed.\n";
+    }
+    $@ = undef;
+}
+if ($needed_total == $needed_there) {
+    print "ok 4\n";
+    $pass__total++;
+}
+else {
+    print "not ok 4\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
+
+use Config;
+
+my $extensions_total = 0;
+my $extensions_there = 0;
+if (defined($Config{'extensions'})) {
+    my @extensions = split(/\s+/,$Config{'extensions'});
+    foreach (@extensions) {
+        next if ($_ eq '');
+        next if ($_ eq 'Devel/DProf'); 
+           # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
+           # \NT> perl  -e "eval \"require 'Devel/DProf.pm'\"; print $@"
+           # DProf: run perl with -d to use DProf.
+           # Compilation failed in require at (eval 1) line 1.
+        eval " require \"$_.pm\"; ";
+        if (!$@) {
+            print "## Module `$_' appears to be installed.\n" if $opt{'v'};
+            $extensions_there++;
+        }
+        else {
+            print "# Required module `$_' does not appear to be properly installed.\n";
+            $@ = undef;
+        }
+        $extensions_total++;
+    }
+
+    # A silly name for a module (that hopefully won't ever exist).
+    # Note that this test serves more as a check of the validity of the
+    # actuall required module tests above.
+    my $unnecessary = 'bLuRfle';
+
+    if (!grep(/$unnecessary/, @extensions)) {
+        $@ = undef;
+        eval " require \"$unnecessary.pm\"; ";
+        if ($@) {
+            print "## Unnecessary module `$unnecessary' does not appear to be installed.\n" if $opt{'v'};
+        }
+        else {
+            print "# Unnecessary module `$unnecessary' appears to be installed.\n";
+            $extensions_there++;
+        }
+    }
+    $@ = undef;
+}
+if ($extensions_total == $extensions_there) {
+    print "ok 5\n";
+    $pass__total++;
+}
+else {
+    print "not ok 5\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking installations of later additional extensions.\n" if $opt{'p'};
+
+use ExtUtils::Installed;
+
+my $installed_total = 0;
+my $installed_there = 0;
+my $version_check = 0;
+my $installed = ExtUtils::Installed -> new();
+my @modules = $installed -> modules();
+my @missing = ();
+my $version = undef;
+for (@modules) {
+    $installed_total++;
+    # Consider it there if it contains one or more files,
+    # and has zero missing files,
+    # and has a defined version
+    $version = undef;
+    $version = $installed -> version($_);
+    if ($version) {
+        print "## $_; $version\n" if $opt{'v'};
+        $version_check++;
+    }
+    else {
+        print "# $_; NO VERSION\n" if $opt{'v'};
+    }
+    $version = undef;
+    @missing = ();
+    @missing = $installed -> validate($_);
+    if ($#missing >= 0) {
+        print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
+        print '# ',join(' ',@missing),"\n";
+    }
+    elsif ($#missing == -1) {
+        $installed_there++;
+    }
+    @missing = ();
+}
+if (($installed_total == $installed_there) && 
+    ($installed_total == $version_check)) {
+    print "ok 6\n";
+    $pass__total++;
+}
+else {
+    print "not ok 6\n";
+    $error_total++;
+}
+$tests_total++;
+
+
+print "## Checking installations of *.h -> *.ph header files.\n" if $opt{'p'};
+my $ph_there = 0;
+my $var = undef;
+my $val = undef;
+my $h_file = undef;
+# Just about "any" C implementation ought to have a stdio.h (even if 
+# Config.pm may not list a i_stdio var).
+my @ph_files = qw(stdio.ph);
+# Add the ones that we know that perl thinks are there:
+while (($var, $val) = each %Config) {
+    if ($var =~ m/i_(.+)/ && $val eq 'define') {
+        $h_file = $1;
+        # This ought to distinguish syslog from sys/syslog.
+        # (NB syslog.ph is heavily used for the DBI pre-requisites).
+        $h_file =~ s{^sys(.+)}{sys/$1} unless $h_file eq 'syslog';
+        push(@ph_files, "$h_file.ph");
+    }
+}
+#foreach (qw(stdio.ph syslog.ph)) {
+foreach (@ph_files) {
+    $@ = undef;
+    eval "require \"$_\";";
+    if (!$@) {
+        print "## Perl header `$_' appears to be installed.\n" if $opt{'v'};
+        $ph_there++;
+    }
+    else {
+        print "# Perl header `$_' does not appear to be properly installed.\n";
+    }
+    $@ = undef;
+}
+
+if (scalar(@ph_files) == $ph_there) {
+    print "ok 7\n";
+    $pass__total++;
+}
+else {
+    print "not ok 7\n";
+    $error_total++;
+}
+$tests_total++;
+
+# Final report (rather than feed ousrselves to Test::Harness::runtests()
+# we simply format some output on our own to keep things simple and
+# easier to "fix" - at least for now.
+
+if ($error_total == 0 && $tests_total) {
+    print "All tests successful.\n";
+} elsif ($tests_total==0){
+        die "FAILED--no tests were run for some reason.\n";
+} else {
+    my $rate = 0.0;
+    if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
+    printf " %d/%d subtests failed, %.2f%% okay.\n",
+                              $error_total, $tests_total, $rate;
+}
+
+=head1 NAME
+
+B<perlivp> - Perl Installation Verification Procedure
+
+=head1 SYNOPSIS
+
+B<perlivp> [B<-p>] [B<-v>] [B<-h>]
+
+=head1 DESCRIPTION
+
+The B<perlivp> program is set up at Perl source code build time to test the
+Perl version it was built under.  It can be used after running:
+
+    make install
+
+(or your platform's equivalent procedure) to verify that B<perl> and its
+libraries have been installed correctly.  A correct installation is verified
+by output that looks like:
+
+    ok 1
+    ok 2
+
+etc.
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-h> help
+
+Prints out a brief help message.
+
+=item B<-p> print preface
+
+Gives a description of each test prior to performing it.
+
+=item B<-v> verbose
+
+Gives more detailed information about each test, after it has been performed.
+Note that any failed tests ought to print out some extra information whether
+or not -v is thrown.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item * print "# Perl binary `$perlpath' does not appear executable.\n";
+
+Likely to occur for a perl binary that was not properly installed.
+Correct by conducting a proper installation.
+
+=item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
+
+Likely to occur for a perl that was not properly installed.
+Correct by conducting a proper installation.
+
+=item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
+
+Likely to occur for a perl library tree that was not properly installed.
+Correct by conducting a proper installation.
+
+=item * print "# Needed module `$_' does not appear to be properly installed.\n";
+
+One of the two modules that is used by perlivp was not present in the 
+installation.  This is a serious error since it adversely affects perlivp's
+ability to function.  You may be able to correct this by performing a
+proper perl installation.
+
+=item * print "# Required module `$_' does not appear to be properly installed.\n";
+
+An attempt to C<eval "require $module"> failed, even though the list of 
+extensions indicated that it should succeed.  Correct by conducting a proper 
+installation.
+
+=item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
+
+This test not coming out ok could indicate that you have in fact installed 
+a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
+test may give misleading results with your installation of perl.  If yours
+is the latter case then please let the author know.
+
+=item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
+
+One or more files turned up missing according to a run of 
+C<ExtUtils::Installed -E<gt> validate()> over your installation.
+Correct by conducting a proper installation.
+
+=item * print "# Perl header `$_' does not appear to be properly installed.\n";
+
+Correct by running B<h2ph> over your system's C header files.  If necessary, 
+edit the resulting *.ph files to eliminate perl syntax errors.
+
+=back
+
+For further information on how to conduct a proper installation consult the 
+INSTALL file that comes with the perl source and the README file for your 
+platform.
+
+=head1 AUTHOR
+
+Peter Prymmer
+
+=cut
+
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
+
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index 2dc013b05d..22139b2169 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -328,7 +328,7 @@ CRTLOPTS =,$(CRTL)/Options
 LIBPREREQ = $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm [.lib]XSLoader.pm [.lib]lib.pm [.lib]vmsish.pm [.lib.ExtUtils]XSSymSet.pm $(ARCHDIR)vmspipe.com [.lib]re.pm
 
 utils1 = [.lib.pod]perldoc.com [.lib.ExtUtils]Miniperl.pm [.utils]c2ph.com [.utils]h2ph.com [.utils]h2xs.com [.lib]perlbug.com [.lib]perlcc.com [.utils]dprofpp.com
-utils2 = [.lib]splain.com [.utils]pl2pm.com
+utils2 = [.utils]perlivp.com [.lib]splain.com [.utils]pl2pm.com
 
 .ifdef NOX2P
 all : base extras archcorefiles preplibrary perlpods
@@ -511,6 +511,9 @@ dynext : $(LIBPREREQ) $(DBG)perlshr$(E) preplibrary
 [.lib.ExtUtils]Miniperl.pm : Minimod.PL miniperlmain.c $(ARCHDIR)Config.pm
 	$(MINIPERL) $(MMS$SOURCE) >$(MMS$TARGET)
 
+[.utils]perlivp.com : [.utils]perlivp.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) $(MMS$SOURCE)
+
 [.utils]c2ph.com : [.utils]c2ph.PL $(ARCHDIR)Config.pm
 	$(MINIPERL) $(MMS$SOURCE)
 
@@ -1317,6 +1320,7 @@ realclean : clean
 	- If F$Search("[.lib.ExtUtils]XSSymSet.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]XSSymSet.pm;*
 	- If F$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;*
 	- If F$Search("[.lib.pod]perldoc.com").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.com;*
+	- If F$Search("[.utils]perlivp.com").nes."" Then Delete/NoConfirm/Log [.utils]perlivp.com;*
 	- If F$Search("[.lib.pod]pod2*.com").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.com;*
 	- If F$Search("[.t.lib]vms*.t").nes."" Then Delete/NoConfirm/Log [.t.lib]vms*.t;*
 	- If F$Search("[...]*$(E)").nes."" Then Delete/NoConfirm/Log [...]*$(E);*
diff --git a/win32/Makefile b/win32/Makefile
index f43c9cec90..b17a698495 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -457,6 +457,7 @@ UTILS		=			\
 		..\utils\h2xs		\
 		..\utils\perldoc	\
 		..\utils\perlcc		\
+		..\utils\perlivp	\
 		..\utils\libnetcfg	\
 		..\pod\checkpods	\
 		..\pod\pod2html		\
@@ -1032,7 +1033,7 @@ distclean: clean
 	    perlwin32.pod pod2html pod2latex pod2man pod2text pod2usage \
 	    podchecker podselect
 	cd ..\utils
-	-del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc dprofpp
+	-del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc perlivp dprofpp
 	-del /f *.bat
 	cd ..\win32
 	cd ..\x2p
diff --git a/win32/makefile.mk b/win32/makefile.mk
index bdab9548e1..f784a4f37f 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -593,6 +593,7 @@ UTILS		=			\
 		..\utils\h2xs		\
 		..\utils\perldoc	\
 		..\utils\perlcc		\
+		..\utils\perlivp	\
 		..\utils\libnetcfg	\
 		..\pod\checkpods	\
 		..\pod\pod2html		\
@@ -1169,7 +1170,7 @@ distclean: clean
 	    perlwin32.pod pod2html pod2latex pod2man pod2text pod2usage \
 	    podchecker podselect
 	-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc \
-	    dprofpp *.bat
+	    perlivp dprofpp *.bat
 	-cd ..\x2p && del /f find2perl s2p *.bat
 	-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
 	-del /f $(CONFIGPM)