This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldiag: ‘Opening dirhandle also as file’ is a default warning
[perl5.git] / utils / perlivp.PL
index ceefc3d..c2f0a11 100644 (file)
@@ -44,9 +44,8 @@ sub usage {
     print << "    EOUSAGE";
 Usage:
 
-    $0 [-a] [-p] [-v] | [-h]
+    $0 [-p] [-v] | [-h]
 
-    -a Run all tests (default is to skip .ph tests)
     -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
@@ -66,8 +65,8 @@ while ($ARGV[0] =~ /^-/) {
         usage() if '?' =~ /\Q$flag/;
         usage() if 'h' =~ /\Q$flag/;
         usage() if 'H' =~ /\Q$flag/;
-        usage("unknown flag: `$flag'") unless 'HhPpVva' =~ /\Q$flag/;
-        warn "$0: `$flag' flag already set\n" if $opt{$flag}++;
+        usage("unknown flag: '$flag'") unless 'HhPpVv' =~ /\Q$flag/;
+        warn "$0: '$flag' flag already set\n" if $opt{$flag}++;
     } 
     shift;
 }
@@ -81,7 +80,7 @@ my $tests_total = 0;
 
 !NO!SUBS!
 
-# We cannot merely check the variable `$^X' in general since on many 
+# 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'}; }
@@ -99,22 +98,24 @@ my \$useithreads = '$useithreads';
 
 print OUT <<'!NO!SUBS!';
 
-print "## Checking Perl binary via variable `\$perlpath' = $perlpath.\n" if $opt{'p'};
+print "## Checking Perl binary via variable '\$perlpath' = $perlpath.\n" if $opt{'p'};
+
+my $label = 'Executable perl binary';
 
 if (-x $perlpath) {
-    print "## Perl binary `$perlpath' appears executable.\n" if $opt{'v'};
-    print "ok 1\n";
+    print "## Perl binary '$perlpath' appears executable.\n" if $opt{'v'};
+    print "ok 1 $label\n";
     $pass__total++;
 }
 else {
-    print "# Perl binary `$perlpath' does not appear executable.\n";
-    print "not ok 1\n";
+    print "# Perl binary '$perlpath' does not appear executable.\n";
+    print "not ok 1 $label\n";
     $error_total++;
 }
 $tests_total++;
 
 
-print "## Checking Perl version via variable `\$]'.\n" if $opt{'p'};
+print "## Checking Perl version via variable '\$]'.\n" if $opt{'p'};
 
 !NO!SUBS!
 
@@ -123,44 +124,52 @@ my \$ivp_VERSION = "$]";
 
 !GROK!THIS!
 print OUT <<'!NO!SUBS!';
+
+$label = 'Perl version correct';
 if ($ivp_VERSION eq $]) {
-    print "## Perl version `$]' appears installed as expected.\n" if $opt{'v'};
-    print "ok 2\n";
+    print "## Perl version '$]' appears installed as expected.\n" if $opt{'v'};
+    print "ok 2 $label\n";
     $pass__total++;
 }
 else {
-    print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
-    print "not ok 2\n";
+    print "# Perl version '$]' installed, expected $ivp_VERSION.\n";
+    print "not ok 2 $label\n";
     $error_total++;
 }
 $tests_total++;
 
+# We have the right perl and version, so now reset @INC so we ignore
+# PERL5LIB and '.'
+{
+    local $ENV{PERL5LIB};
+    my $perl_V = qx($perlpath -V);
+    $perl_V =~ s{.*\@INC:\n}{}ms;
+    @INC = grep { length && $_ ne '.' } split ' ', $perl_V;
+}
 
-print "## Checking roots of the Perl library directory tree via variable `\@INC'.\n" if $opt{'p'};
+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'};
+        print "## Perl \@INC directory '$_' exists.\n" if $opt{'v'};
         $INC_there++;
     }
     else {
-        print "# Perl \@INC directory `$_' does not appear to exist.\n";
+        print "# Perl \@INC directory '$_' does not appear to exist.\n";
     }
     $INC_total++;
 }
+
+$label = '@INC directoreis exist';
 if ($INC_total == $INC_there) {
-    print "ok 3\n";
+    print "ok 3 $label\n";
     $pass__total++;
 }
 else {
-    print "not ok 3\n";
+    print "not ok 3 $label\n";
     $error_total++;
 }
 $tests_total++;
@@ -175,20 +184,21 @@ foreach (qw(Config.pm ExtUtils/Installed.pm)) {
     $needed_total++;
     eval "require \"$_\";";
     if (!$@) {
-        print "## Module `$_' appears to be installed.\n" if $opt{'v'};
+        print "## Module '$_' appears to be installed.\n" if $opt{'v'};
         $needed_there++;
     }
     else {
-        print "# Needed module `$_' does not appear to be properly installed.\n";
+        print "# Needed module '$_' does not appear to be properly installed.\n";
     }
     $@ = undef;
 }
+$label = 'Modules needed for rest of perlivp exist';
 if ($needed_total == $needed_there) {
-    print "ok 4\n";
+    print "ok 4 $label\n";
     $pass__total++;
 }
 else {
-    print "not ok 4\n";
+    print "not ok 4 $label\n";
     $error_total++;
 }
 $tests_total++;
@@ -214,6 +224,7 @@ if (defined($Config{'extensions'})) {
         next if $_ eq 'libnet';
         next if $_ eq 'Locale/Codes';
         next if $_ eq 'podlators';
+        next if $_ eq 'perlfaq';
         # test modules
         next if $_ eq 'XS/APItest';
         next if $_ eq 'XS/Typemap';
@@ -223,11 +234,11 @@ if (defined($Config{'extensions'})) {
            # Compilation failed in require at (eval 1) line 1.
         eval " require \"$_.pm\"; ";
         if (!$@) {
-            print "## Module `$_' appears to be installed.\n" if $opt{'v'};
+            print "## Module '$_' appears to be installed.\n" if $opt{'v'};
             $extensions_there++;
         }
         else {
-            print "# Required module `$_' does not appear to be properly installed.\n";
+            print "# Required module '$_' does not appear to be properly installed.\n";
             $@ = undef;
         }
         $extensions_total++;
@@ -242,21 +253,22 @@ if (defined($Config{'extensions'})) {
         $@ = undef;
         eval " require \"$unnecessary.pm\"; ";
         if ($@) {
-            print "## Unnecessary module `$unnecessary' does not appear to be installed.\n" if $opt{'v'};
+            print "## Unnecessary module '$unnecessary' does not appear to be installed.\n" if $opt{'v'};
         }
         else {
-            print "# Unnecessary module `$unnecessary' appears to be installed.\n";
+            print "# Unnecessary module '$unnecessary' appears to be installed.\n";
             $extensions_there++;
         }
     }
     $@ = undef;
 }
+$label = 'All (and only) expected extensions installed';
 if ($extensions_total == $extensions_there) {
-    print "ok 5\n";
+    print "ok 5 $label\n";
     $pass__total++;
 }
 else {
-    print "not ok 5\n";
+    print "not ok 5 $label\n";
     $error_total++;
 }
 $tests_total++;
@@ -305,73 +317,18 @@ for (@modules) {
     }
     @missing = ();
 }
+$label = 'Module files correctly installed';
 if (($installed_total == $installed_there) && 
     ($installed_total == $version_check)) {
-    print "ok 6\n";
+    print "ok 6 $label\n";
     $pass__total++;
 }
 else {
-    print "not ok 6\n";
+    print "not ok 6 $label\n";
     $error_total++;
 }
 $tests_total++;
 
-
-if ($opt{'a'}) {
-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;
-       # Some header and symbol names don't match for hysterical raisins.
-       $h_file = 'arpa/inet'    if $h_file eq 'arpainet';
-       $h_file = 'netinet/in'   if $h_file eq 'niin';
-       $h_file = 'netinet/tcp'  if $h_file eq 'netinettcp';
-       $h_file = 'sys/resource' if $h_file eq 'sysresrc';
-       $h_file = 'sys/select'   if $h_file eq 'sysselct';
-       $h_file = 'sys/security' if $h_file eq 'syssecrt';
-        $h_file = 'rpcsvc/dbm'   if $h_file eq 'rpcsvcdbm';
-        # This ought to distinguish syslog from sys/syslog.
-        # (NB syslog.ph is heavily used for the DBI pre-requisites).
-        $h_file =~ s{^sys(\w.+)}{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++;
-}
-else {
-    print "##  Skip checking of *.ph header files.\n" if $opt{'p'};
-}
-
 # 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.
@@ -393,7 +350,7 @@ perlivp - Perl Installation Verification Procedure
 
 =head1 SYNOPSIS
 
-B<perlivp> [B<-a>] [B<-p>] [B<-v>] [B<-h>]
+B<perlivp> [B<-p>] [B<-v>] [B<-h>]
 
 =head1 DESCRIPTION
 
@@ -419,11 +376,6 @@ etc.
 
 Prints out a brief help message.
 
-=item B<-a> run all tests
-
-Normally tests for optional features are skipped.  With -a all tests
-are executed.
-
 =item B<-p> print preface
 
 Gives a description of each test prior to performing it.
@@ -440,35 +392,35 @@ or not -v is thrown.
 
 =over 4
 
-=item * print "# Perl binary `$perlpath' does not appear executable.\n";
+=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";
+=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";
+=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";
+=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";
+=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";
+=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\"; ">
@@ -481,11 +433,6 @@ 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