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