utils/perlivp.PL

   1 #!/usr/local/bin/perl
   2
   3 use Config;
   4 use File::Basename;
   5 use Cwd;
   6
   7 # List explicitly here the variables you want Configure to
   8 # generate.  Metaconfig only looks for shell variables, so you
   9 # have to mention them as if they were shell variables, not
  10 # %Config entries:
  11 #  $startperl
  12 #  $perlpath
  13 #  $eunicefix
  14
  15 # This forces PL files to create target in same directory as PL file.
  16 # This is so that make depend always knows where to find PL derivatives.
  17 my $origdir = cwd;
  18 chdir dirname($0);
  19 my $file = basename($0, '.PL');
  20 $file .= '.com' if $^O eq 'VMS';
  21
  22 # Create output file.
  23 open OUT,">$file" or die "Can't create $file: $!";
  24
  25 print "Extracting $file (with variable substitutions)\n";
  26
  27 # In this section, perl variables will be expanded during extraction.
  28 # You can use $Config{...} to use Configure variables.
  29
  30 print OUT <<"!GROK!THIS!";
  31 $Config{'startperl'}
  32     eval 'exec $Config{'perlpath'} -S \$0 \${1+"\$@"}'
  33         if \$running_under_some_shell;
  34 !GROK!THIS!
  35
  36 print OUT "\n# perlivp $^V\n";
  37
  38 # In the following, perl variables are not expanded during extraction.
  39
  40 print OUT <<'!NO!SUBS!';
  41
  42 sub usage {
  43     warn "@_\n" if @_;
  44     print << "    EOUSAGE";
  45 Usage:
  46
  47     $0 [-a] [-p] [-v] | [-h]
  48
  49     -a Run all tests (default is to skip .ph tests)
  50     -p Print a preface before each test telling what it will test.
  51     -v Verbose mode in which extra information about test results
  52        is printed.  Test failures always print out some extra information
  53        regardless of whether or not this switch is set.
  54     -h Prints this help message.
  55     EOUSAGE
  56     exit;
  57 }
  58
  59 use vars qw(%opt); # allow testing with older versions (do not use our)
  60
  61 @opt{ qw/? H h P p V v/ } = qw(0 0 0 0 0 0 0);
  62
  63 while ($ARGV[0] =~ /^-/) {
  64     $ARGV[0] =~ s/^-//;
  65     for my $flag (split(//,$ARGV[0])) {
  66         usage() if '?' =~ /\Q$flag/;
  67         usage() if 'h' =~ /\Q$flag/;
  68         usage() if 'H' =~ /\Q$flag/;
  69         usage("unknown flag: `$flag'") unless 'HhPpVva' =~ /\Q$flag/;
  70         warn "$0: `$flag' flag already set\n" if $opt{$flag}++;
  71     }
  72     shift;
  73 }
  74
  75 $opt{p}++ if $opt{P};
  76 $opt{v}++ if $opt{V};
  77
  78 my $pass__total = 0;
  79 my $error_total = 0;
  80 my $tests_total = 0;
  81
  82 !NO!SUBS!
  83
  84 # We cannot merely check the variable `$^X' in general since on many
  85 # Unixes it is the basename rather than the full path to the perl binary.
  86 my $perlpath = '';
  87 if (defined($Config{'perlpath'})) { $perlpath = $Config{'perlpath'}; }
  88
  89 # The useithreads Config variable plays a role in whether or not
  90 # threads and threads/shared work when C<use>d.  They apparently always
  91 # get installed on systems that can run Configure.
  92 my $useithreads = '';
  93 if (defined($Config{'useithreads'})) { $useithreads = $Config{'useithreads'}; }
  94
  95 print OUT <<"!GROK!THIS!";
  96 my \$perlpath = '$perlpath';
  97 my \$useithreads = '$useithreads';
  98 !GROK!THIS!
  99
 100 print OUT <<'!NO!SUBS!';
 101
 102 print "## Checking Perl binary via variable `\$perlpath' = $perlpath.\n" if $opt{'p'};
 103
 104 if (-x $perlpath) {
 105     print "## Perl binary `$perlpath' appears executable.\n" if $opt{'v'};
 106     print "ok 1\n";
 107     $pass__total++;
 108 }
 109 else {
 110     print "# Perl binary `$perlpath' does not appear executable.\n";
 111     print "not ok 1\n";
 112     $error_total++;
 113 }
 114 $tests_total++;
 115
 116
 117 print "## Checking Perl version via variable `\$]'.\n" if $opt{'p'};
 118
 119 !NO!SUBS!
 120
 121 print OUT <<"!GROK!THIS!";
 122 my \$ivp_VERSION = "$]";
 123
 124 !GROK!THIS!
 125 print OUT <<'!NO!SUBS!';
 126 if ($ivp_VERSION eq $]) {
 127     print "## Perl version `$]' appears installed as expected.\n" if $opt{'v'};
 128     print "ok 2\n";
 129     $pass__total++;
 130 }
 131 else {
 132     print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
 133     print "not ok 2\n";
 134     $error_total++;
 135 }
 136 $tests_total++;
 137
 138
 139 print "## Checking roots of the Perl library directory tree via variable `\@INC'.\n" if $opt{'p'};
 140
 141 my $INC_total = 0;
 142 my $INC_there = 0;
 143 foreach (@INC) {
 144     next if $_ eq '.'; # skip -d test here
 145     if ($^O eq 'MacOS') {
 146         next if $_ eq ':'; # skip -d test here
 147         next if $_ eq 'Dev:Pseudo:'; # why is this in @INC?
 148     }
 149     if (-d $_) {
 150         print "## Perl \@INC directory `$_' exists.\n" if $opt{'v'};
 151         $INC_there++;
 152     }
 153     else {
 154         print "# Perl \@INC directory `$_' does not appear to exist.\n";
 155     }
 156     $INC_total++;
 157 }
 158 if ($INC_total == $INC_there) {
 159     print "ok 3\n";
 160     $pass__total++;
 161 }
 162 else {
 163     print "not ok 3\n";
 164     $error_total++;
 165 }
 166 $tests_total++;
 167
 168
 169 print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
 170
 171 my $needed_total = 0;
 172 my $needed_there = 0;
 173 foreach (qw(Config.pm ExtUtils/Installed.pm)) {
 174     $@ = undef;
 175     $needed_total++;
 176     eval "require \"$_\";";
 177     if (!$@) {
 178         print "## Module `$_' appears to be installed.\n" if $opt{'v'};
 179         $needed_there++;
 180     }
 181     else {
 182         print "# Needed module `$_' does not appear to be properly installed.\n";
 183     }
 184     $@ = undef;
 185 }
 186 if ($needed_total == $needed_there) {
 187     print "ok 4\n";
 188     $pass__total++;
 189 }
 190 else {
 191     print "not ok 4\n";
 192     $error_total++;
 193 }
 194 $tests_total++;
 195
 196
 197 print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
 198
 199 use Config;
 200
 201 my $extensions_total = 0;
 202 my $extensions_there = 0;
 203 if (defined($Config{'extensions'})) {
 204     my @extensions = split(/\s+/,$Config{'extensions'});
 205     foreach (@extensions) {
 206         next if ($_ eq '');
 207         if ( $useithreads !~ /define/i ) {
 208             next if ($_ eq 'threads');
 209             next if ($_ eq 'threads/shared');
 210         }
 211         # that's a distribution name, not a module name
 212         next if $_ eq 'IO/Compress';
 213         next if $_ eq 'Devel/DProf';
 214         next if $_ eq 'libnet';
 215         next if $_ eq 'Locale/Codes';
 216         next if $_ eq 'podlators';
 217         # test modules
 218         next if $_ eq 'XS/APItest';
 219         next if $_ eq 'XS/APItest/KeywordRPN';
 220         next if $_ eq 'XS/Typemap';
 221            # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
 222            # \NT> perl  -e "eval \"require 'Devel/DProf.pm'\"; print $@"
 223            # DProf: run perl with -d to use DProf.
 224            # Compilation failed in require at (eval 1) line 1.
 225         eval " require \"$_.pm\"; ";
 226         if (!$@) {
 227             print "## Module `$_' appears to be installed.\n" if $opt{'v'};
 228             $extensions_there++;
 229         }
 230         else {
 231             print "# Required module `$_' does not appear to be properly installed.\n";
 232             $@ = undef;
 233         }
 234         $extensions_total++;
 235     }
 236
 237     # A silly name for a module (that hopefully won't ever exist).
 238     # Note that this test serves more as a check of the validity of the
 239     # actuall required module tests above.
 240     my $unnecessary = 'bLuRfle';
 241
 242     if (!grep(/$unnecessary/, @extensions)) {
 243         $@ = undef;
 244         eval " require \"$unnecessary.pm\"; ";
 245         if ($@) {
 246             print "## Unnecessary module `$unnecessary' does not appear to be installed.\n" if $opt{'v'};
 247         }
 248         else {
 249             print "# Unnecessary module `$unnecessary' appears to be installed.\n";
 250             $extensions_there++;
 251         }
 252     }
 253     $@ = undef;
 254 }
 255 if ($extensions_total == $extensions_there) {
 256     print "ok 5\n";
 257     $pass__total++;
 258 }
 259 else {
 260     print "not ok 5\n";
 261     $error_total++;
 262 }
 263 $tests_total++;
 264
 265
 266 print "## Checking installations of later additional extensions.\n" if $opt{'p'};
 267
 268 use ExtUtils::Installed;
 269
 270 my $installed_total = 0;
 271 my $installed_there = 0;
 272 my $version_check = 0;
 273 my $installed = ExtUtils::Installed -> new();
 274 my @modules = $installed -> modules();
 275 my @missing = ();
 276 my $version = undef;
 277 for (@modules) {
 278     $installed_total++;
 279     # Consider it there if it contains one or more files,
 280     # and has zero missing files,
 281     # and has a defined version
 282     $version = undef;
 283     $version = $installed -> version($_);
 284     if ($version) {
 285         print "## $_; $version\n" if $opt{'v'};
 286         $version_check++;
 287     }
 288     else {
 289         print "# $_; NO VERSION\n" if $opt{'v'};
 290     }
 291     $version = undef;
 292     @missing = ();
 293     @missing = $installed -> validate($_);
 294
 295     # .bs files are optional
 296     @missing = grep { ! /\.bs$/ } @missing;
 297     # man files are often compressed
 298     @missing = grep { ! ( -s "$_.gz" || -s "$_.bz2" ) } @missing;
 299
 300     if ($#missing >= 0) {
 301         print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 302         print '# ',join(' ',@missing),"\n";
 303     }
 304     elsif ($#missing == -1) {
 305         $installed_there++;
 306     }
 307     @missing = ();
 308 }
 309 if (($installed_total == $installed_there) &&
 310     ($installed_total == $version_check)) {
 311     print "ok 6\n";
 312     $pass__total++;
 313 }
 314 else {
 315     print "not ok 6\n";
 316     $error_total++;
 317 }
 318 $tests_total++;
 319
 320
 321 if ($opt{'a'}) {
 322 print "## Checking installations of *.h -> *.ph header files.\n" if $opt{'p'};
 323 my $ph_there = 0;
 324 my $var = undef;
 325 my $val = undef;
 326 my $h_file = undef;
 327 # Just about "any" C implementation ought to have a stdio.h (even if
 328 # Config.pm may not list a i_stdio var).
 329 my @ph_files = qw(stdio.ph);
 330 # Add the ones that we know that perl thinks are there:
 331 while (($var, $val) = each %Config) {
 332     if ($var =~ m/i_(.+)/ && $val eq 'define') {
 333         $h_file = $1;
 334         # Some header and symbol names don't match for hysterical raisins.
 335         $h_file = 'arpa/inet'    if $h_file eq 'arpainet';
 336         $h_file = 'netinet/in'   if $h_file eq 'niin';
 337         $h_file = 'netinet/tcp'  if $h_file eq 'netinettcp';
 338         $h_file = 'sys/resource' if $h_file eq 'sysresrc';
 339         $h_file = 'sys/select'   if $h_file eq 'sysselct';
 340         $h_file = 'sys/security' if $h_file eq 'syssecrt';
 341         $h_file = 'rpcsvc/dbm'   if $h_file eq 'rpcsvcdbm';
 342         # This ought to distinguish syslog from sys/syslog.
 343         # (NB syslog.ph is heavily used for the DBI pre-requisites).
 344         $h_file =~ s{^sys(\w.+)}{sys/$1} unless $h_file eq 'syslog';
 345         push(@ph_files, "$h_file.ph");
 346     }
 347 }
 348 #foreach (qw(stdio.ph syslog.ph)) {
 349 foreach (@ph_files) {
 350     $@ = undef;
 351     eval "require \"$_\";";
 352     if (!$@) {
 353         print "## Perl header `$_' appears to be installed.\n" if $opt{'v'};
 354         $ph_there++;
 355     }
 356     else {
 357         print "# Perl header `$_' does not appear to be properly installed.\n";
 358     }
 359     $@ = undef;
 360 }
 361
 362 if (scalar(@ph_files) == $ph_there) {
 363     print "ok 7\n";
 364     $pass__total++;
 365 }
 366 else {
 367     print "not ok 7\n";
 368     $error_total++;
 369 }
 370 $tests_total++;
 371 }
 372 else {
 373     print "##  Skip checking of *.ph header files.\n" if $opt{'p'};
 374 }
 375
 376 # Final report (rather than feed ousrselves to Test::Harness::runtests()
 377 # we simply format some output on our own to keep things simple and
 378 # easier to "fix" - at least for now.
 379
 380 if ($error_total == 0 && $tests_total) {
 381     print "All tests successful.\n";
 382 } elsif ($tests_total==0){
 383         die "FAILED--no tests were run for some reason.\n";
 384 } else {
 385     my $rate = 0.0;
 386     if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
 387     printf " %d/%d subtests failed, %.2f%% okay.\n",
 388                               $error_total, $tests_total, $rate;
 389 }
 390
 391 =head1 NAME
 392
 393 perlivp - Perl Installation Verification Procedure
 394
 395 =head1 SYNOPSIS
 396
 397 B<perlivp> [B<-a>] [B<-p>] [B<-v>] [B<-h>]
 398
 399 =head1 DESCRIPTION
 400
 401 The B<perlivp> program is set up at Perl source code build time to test the
 402 Perl version it was built under.  It can be used after running:
 403
 404     make install
 405
 406 (or your platform's equivalent procedure) to verify that B<perl> and its
 407 libraries have been installed correctly.  A correct installation is verified
 408 by output that looks like:
 409
 410     ok 1
 411     ok 2
 412
 413 etc.
 414
 415 =head1 OPTIONS
 416
 417 =over 5
 418
 419 =item B<-h> help
 420
 421 Prints out a brief help message.
 422
 423 =item B<-a> run all tests
 424
 425 Normally tests for optional features are skipped.  With -a all tests
 426 are executed.
 427
 428 =item B<-p> print preface
 429
 430 Gives a description of each test prior to performing it.
 431
 432 =item B<-v> verbose
 433
 434 Gives more detailed information about each test, after it has been performed.
 435 Note that any failed tests ought to print out some extra information whether
 436 or not -v is thrown.
 437
 438 =back
 439
 440 =head1 DIAGNOSTICS
 441
 442 =over 4
 443
 444 =item * print "# Perl binary `$perlpath' does not appear executable.\n";
 445
 446 Likely to occur for a perl binary that was not properly installed.
 447 Correct by conducting a proper installation.
 448
 449 =item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
 450
 451 Likely to occur for a perl that was not properly installed.
 452 Correct by conducting a proper installation.
 453
 454 =item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
 455
 456 Likely to occur for a perl library tree that was not properly installed.
 457 Correct by conducting a proper installation.
 458
 459 =item * print "# Needed module `$_' does not appear to be properly installed.\n";
 460
 461 One of the two modules that is used by perlivp was not present in the
 462 installation.  This is a serious error since it adversely affects perlivp's
 463 ability to function.  You may be able to correct this by performing a
 464 proper perl installation.
 465
 466 =item * print "# Required module `$_' does not appear to be properly installed.\n";
 467
 468 An attempt to C<eval "require $module"> failed, even though the list of
 469 extensions indicated that it should succeed.  Correct by conducting a proper
 470 installation.
 471
 472 =item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
 473
 474 This test not coming out ok could indicate that you have in fact installed
 475 a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
 476 test may give misleading results with your installation of perl.  If yours
 477 is the latter case then please let the author know.
 478
 479 =item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 480
 481 One or more files turned up missing according to a run of
 482 C<ExtUtils::Installed -E<gt> validate()> over your installation.
 483 Correct by conducting a proper installation.
 484
 485 =item * print "# Perl header `$_' does not appear to be properly installed.\n";
 486
 487 Correct by running B<h2ph> over your system's C header files.  If necessary,
 488 edit the resulting *.ph files to eliminate perl syntax errors.
 489
 490 =back
 491
 492 For further information on how to conduct a proper installation consult the
 493 INSTALL file that comes with the perl source and the README file for your
 494 platform.
 495
 496 =head1 AUTHOR
 497
 498 Peter Prymmer
 499
 500 =cut
 501
 502 !NO!SUBS!
 503
 504 close OUT or die "Can't close $file: $!";
 505 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 506 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
 507 chdir $origdir;
 508