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         # test modules
 215         next if $_ eq 'XS/APItest';
 216         next if $_ eq 'XS/APItest/KeywordRPN';
 217         next if $_ eq 'XS/Typemap';
 218            # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
 219            # \NT> perl  -e "eval \"require 'Devel/DProf.pm'\"; print $@"
 220            # DProf: run perl with -d to use DProf.
 221            # Compilation failed in require at (eval 1) line 1.
 222         eval " require \"$_.pm\"; ";
 223         if (!$@) {
 224             print "## Module `$_' appears to be installed.\n" if $opt{'v'};
 225             $extensions_there++;
 226         }
 227         else {
 228             print "# Required module `$_' does not appear to be properly installed.\n";
 229             $@ = undef;
 230         }
 231         $extensions_total++;
 232     }
 233
 234     # A silly name for a module (that hopefully won't ever exist).
 235     # Note that this test serves more as a check of the validity of the
 236     # actuall required module tests above.
 237     my $unnecessary = 'bLuRfle';
 238
 239     if (!grep(/$unnecessary/, @extensions)) {
 240         $@ = undef;
 241         eval " require \"$unnecessary.pm\"; ";
 242         if ($@) {
 243             print "## Unnecessary module `$unnecessary' does not appear to be installed.\n" if $opt{'v'};
 244         }
 245         else {
 246             print "# Unnecessary module `$unnecessary' appears to be installed.\n";
 247             $extensions_there++;
 248         }
 249     }
 250     $@ = undef;
 251 }
 252 if ($extensions_total == $extensions_there) {
 253     print "ok 5\n";
 254     $pass__total++;
 255 }
 256 else {
 257     print "not ok 5\n";
 258     $error_total++;
 259 }
 260 $tests_total++;
 261
 262
 263 print "## Checking installations of later additional extensions.\n" if $opt{'p'};
 264
 265 use ExtUtils::Installed;
 266
 267 my $installed_total = 0;
 268 my $installed_there = 0;
 269 my $version_check = 0;
 270 my $installed = ExtUtils::Installed -> new();
 271 my @modules = $installed -> modules();
 272 my @missing = ();
 273 my $version = undef;
 274 for (@modules) {
 275     $installed_total++;
 276     # Consider it there if it contains one or more files,
 277     # and has zero missing files,
 278     # and has a defined version
 279     $version = undef;
 280     $version = $installed -> version($_);
 281     if ($version) {
 282         print "## $_; $version\n" if $opt{'v'};
 283         $version_check++;
 284     }
 285     else {
 286         print "# $_; NO VERSION\n" if $opt{'v'};
 287     }
 288     $version = undef;
 289     @missing = ();
 290     @missing = $installed -> validate($_);
 291
 292     # .bs files are optional
 293     @missing = grep { ! /\.bs$/ } @missing;
 294     # man files are often compressed
 295     @missing = grep { ! ( -s "$_.gz" || -s "$_.bz2" ) } @missing;
 296
 297     if ($#missing >= 0) {
 298         print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 299         print '# ',join(' ',@missing),"\n";
 300     }
 301     elsif ($#missing == -1) {
 302         $installed_there++;
 303     }
 304     @missing = ();
 305 }
 306 if (($installed_total == $installed_there) &&
 307     ($installed_total == $version_check)) {
 308     print "ok 6\n";
 309     $pass__total++;
 310 }
 311 else {
 312     print "not ok 6\n";
 313     $error_total++;
 314 }
 315 $tests_total++;
 316
 317
 318 if ($opt{'a'}) {
 319 print "## Checking installations of *.h -> *.ph header files.\n" if $opt{'p'};
 320 my $ph_there = 0;
 321 my $var = undef;
 322 my $val = undef;
 323 my $h_file = undef;
 324 # Just about "any" C implementation ought to have a stdio.h (even if
 325 # Config.pm may not list a i_stdio var).
 326 my @ph_files = qw(stdio.ph);
 327 # Add the ones that we know that perl thinks are there:
 328 while (($var, $val) = each %Config) {
 329     if ($var =~ m/i_(.+)/ && $val eq 'define') {
 330         $h_file = $1;
 331         # Some header and symbol names don't match for hysterical raisins.
 332         $h_file = 'arpa/inet'    if $h_file eq 'arpainet';
 333         $h_file = 'netinet/in'   if $h_file eq 'niin';
 334         $h_file = 'netinet/tcp'  if $h_file eq 'netinettcp';
 335         $h_file = 'sys/resource' if $h_file eq 'sysresrc';
 336         $h_file = 'sys/select'   if $h_file eq 'sysselct';
 337         $h_file = 'sys/security' if $h_file eq 'syssecrt';
 338         $h_file = 'rpcsvc/dbm'   if $h_file eq 'rpcsvcdbm';
 339         # This ought to distinguish syslog from sys/syslog.
 340         # (NB syslog.ph is heavily used for the DBI pre-requisites).
 341         $h_file =~ s{^sys(\w.+)}{sys/$1} unless $h_file eq 'syslog';
 342         push(@ph_files, "$h_file.ph");
 343     }
 344 }
 345 #foreach (qw(stdio.ph syslog.ph)) {
 346 foreach (@ph_files) {
 347     $@ = undef;
 348     eval "require \"$_\";";
 349     if (!$@) {
 350         print "## Perl header `$_' appears to be installed.\n" if $opt{'v'};
 351         $ph_there++;
 352     }
 353     else {
 354         print "# Perl header `$_' does not appear to be properly installed.\n";
 355     }
 356     $@ = undef;
 357 }
 358
 359 if (scalar(@ph_files) == $ph_there) {
 360     print "ok 7\n";
 361     $pass__total++;
 362 }
 363 else {
 364     print "not ok 7\n";
 365     $error_total++;
 366 }
 367 $tests_total++;
 368 }
 369 else {
 370     print "##  Skip checking of *.ph header files.\n" if $opt{'p'};
 371 }
 372
 373 # Final report (rather than feed ousrselves to Test::Harness::runtests()
 374 # we simply format some output on our own to keep things simple and
 375 # easier to "fix" - at least for now.
 376
 377 if ($error_total == 0 && $tests_total) {
 378     print "All tests successful.\n";
 379 } elsif ($tests_total==0){
 380         die "FAILED--no tests were run for some reason.\n";
 381 } else {
 382     my $rate = 0.0;
 383     if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
 384     printf " %d/%d subtests failed, %.2f%% okay.\n",
 385                               $error_total, $tests_total, $rate;
 386 }
 387
 388 =head1 NAME
 389
 390 perlivp - Perl Installation Verification Procedure
 391
 392 =head1 SYNOPSIS
 393
 394 B<perlivp> [B<-a>] [B<-p>] [B<-v>] [B<-h>]
 395
 396 =head1 DESCRIPTION
 397
 398 The B<perlivp> program is set up at Perl source code build time to test the
 399 Perl version it was built under.  It can be used after running:
 400
 401     make install
 402
 403 (or your platform's equivalent procedure) to verify that B<perl> and its
 404 libraries have been installed correctly.  A correct installation is verified
 405 by output that looks like:
 406
 407     ok 1
 408     ok 2
 409
 410 etc.
 411
 412 =head1 OPTIONS
 413
 414 =over 5
 415
 416 =item B<-h> help
 417
 418 Prints out a brief help message.
 419
 420 =item B<-a> run all tests
 421
 422 Normally tests for optional features are skipped.  With -a all tests
 423 are executed.
 424
 425 =item B<-p> print preface
 426
 427 Gives a description of each test prior to performing it.
 428
 429 =item B<-v> verbose
 430
 431 Gives more detailed information about each test, after it has been performed.
 432 Note that any failed tests ought to print out some extra information whether
 433 or not -v is thrown.
 434
 435 =back
 436
 437 =head1 DIAGNOSTICS
 438
 439 =over 4
 440
 441 =item * print "# Perl binary `$perlpath' does not appear executable.\n";
 442
 443 Likely to occur for a perl binary that was not properly installed.
 444 Correct by conducting a proper installation.
 445
 446 =item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
 447
 448 Likely to occur for a perl that was not properly installed.
 449 Correct by conducting a proper installation.
 450
 451 =item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
 452
 453 Likely to occur for a perl library tree that was not properly installed.
 454 Correct by conducting a proper installation.
 455
 456 =item * print "# Needed module `$_' does not appear to be properly installed.\n";
 457
 458 One of the two modules that is used by perlivp was not present in the
 459 installation.  This is a serious error since it adversely affects perlivp's
 460 ability to function.  You may be able to correct this by performing a
 461 proper perl installation.
 462
 463 =item * print "# Required module `$_' does not appear to be properly installed.\n";
 464
 465 An attempt to C<eval "require $module"> failed, even though the list of
 466 extensions indicated that it should succeed.  Correct by conducting a proper
 467 installation.
 468
 469 =item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
 470
 471 This test not coming out ok could indicate that you have in fact installed
 472 a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
 473 test may give misleading results with your installation of perl.  If yours
 474 is the latter case then please let the author know.
 475
 476 =item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 477
 478 One or more files turned up missing according to a run of
 479 C<ExtUtils::Installed -E<gt> validate()> over your installation.
 480 Correct by conducting a proper installation.
 481
 482 =item * print "# Perl header `$_' does not appear to be properly installed.\n";
 483
 484 Correct by running B<h2ph> over your system's C header files.  If necessary,
 485 edit the resulting *.ph files to eliminate perl syntax errors.
 486
 487 =back
 488
 489 For further information on how to conduct a proper installation consult the
 490 INSTALL file that comes with the perl source and the README file for your
 491 platform.
 492
 493 =head1 AUTHOR
 494
 495 Peter Prymmer
 496
 497 =cut
 498
 499 !NO!SUBS!
 500
 501 close OUT or die "Can't close $file: $!";
 502 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 503 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
 504 chdir $origdir;
 505