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 0; # ^ Run only under a 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 BEGIN { pop @INC if $INC[-1] eq '.' }
  43
  44 sub usage {
  45     warn "@_\n" if @_;
  46     print << "    EOUSAGE";
  47 Usage:
  48
  49     $0 [-p] [-v] | [-h]
  50
  51     -p Print a preface before each test telling what it will test.
  52     -v Verbose mode in which extra information about test results
  53        is printed.  Test failures always print out some extra information
  54        regardless of whether or not this switch is set.
  55     -h Prints this help message.
  56     EOUSAGE
  57     exit;
  58 }
  59
  60 use vars qw(%opt); # allow testing with older versions (do not use our)
  61
  62 @opt{ qw/? H h P p V v/ } = qw(0 0 0 0 0 0 0);
  63
  64 while ($ARGV[0] =~ /^-/) {
  65     $ARGV[0] =~ s/^-//;
  66     for my $flag (split(//,$ARGV[0])) {
  67         usage() if '?' =~ /\Q$flag/;
  68         usage() if 'h' =~ /\Q$flag/;
  69         usage() if 'H' =~ /\Q$flag/;
  70         usage("unknown flag: '$flag'") unless 'HhPpVv' =~ /\Q$flag/;
  71         warn "$0: '$flag' flag already set\n" if $opt{$flag}++;
  72     }
  73     shift;
  74 }
  75
  76 $opt{p}++ if $opt{P};
  77 $opt{v}++ if $opt{V};
  78
  79 my $pass__total = 0;
  80 my $error_total = 0;
  81 my $tests_total = 0;
  82
  83 !NO!SUBS!
  84
  85 # We cannot merely check the variable '$^X' in general since on many
  86 # Unixes it is the basename rather than the full path to the perl binary.
  87 my $perlpath = '';
  88 if (defined($Config{'perlpath'})) { $perlpath = $Config{'perlpath'}; }
  89
  90 # The useithreads Config variable plays a role in whether or not
  91 # threads and threads/shared work when C<use>d.  They apparently always
  92 # get installed on systems that can run Configure.
  93 my $useithreads = '';
  94 if (defined($Config{'useithreads'})) { $useithreads = $Config{'useithreads'}; }
  95
  96 print OUT <<"!GROK!THIS!";
  97 my \$perlpath = '$perlpath';
  98 my \$useithreads = '$useithreads';
  99 !GROK!THIS!
 100
 101 print OUT <<'!NO!SUBS!';
 102
 103 print "## Checking Perl binary via variable '\$perlpath' = $perlpath.\n" if $opt{'p'};
 104
 105 my $label = 'Executable perl binary';
 106
 107 if (-x $perlpath) {
 108     print "## Perl binary '$perlpath' appears executable.\n" if $opt{'v'};
 109     print "ok 1 $label\n";
 110     $pass__total++;
 111 }
 112 else {
 113     print "# Perl binary '$perlpath' does not appear executable.\n";
 114     print "not ok 1 $label\n";
 115     $error_total++;
 116 }
 117 $tests_total++;
 118
 119
 120 print "## Checking Perl version via variable '\$]'.\n" if $opt{'p'};
 121
 122 !NO!SUBS!
 123
 124 print OUT <<"!GROK!THIS!";
 125 my \$ivp_VERSION = "$]";
 126
 127 !GROK!THIS!
 128 print OUT <<'!NO!SUBS!';
 129
 130 $label = 'Perl version correct';
 131 if ($ivp_VERSION eq $]) {
 132     print "## Perl version '$]' appears installed as expected.\n" if $opt{'v'};
 133     print "ok 2 $label\n";
 134     $pass__total++;
 135 }
 136 else {
 137     print "# Perl version '$]' installed, expected $ivp_VERSION.\n";
 138     print "not ok 2 $label\n";
 139     $error_total++;
 140 }
 141 $tests_total++;
 142
 143 # We have the right perl and version, so now reset @INC so we ignore
 144 # PERL5LIB and '.'
 145 {
 146     local $ENV{PERL5LIB};
 147     my $perl_V = qx($perlpath -V);
 148     $perl_V =~ s{.*\@INC:\n}{}ms;
 149     @INC = grep { length && $_ ne '.' } split ' ', $perl_V;
 150 }
 151
 152 print "## Checking roots of the Perl library directory tree via variable '\@INC'.\n" if $opt{'p'};
 153
 154 my $INC_total = 0;
 155 my $INC_there = 0;
 156 foreach (@INC) {
 157     next if $_ eq '.'; # skip -d test here
 158     if (-d $_) {
 159         print "## Perl \@INC directory '$_' exists.\n" if $opt{'v'};
 160         $INC_there++;
 161     }
 162     else {
 163         print "# Perl \@INC directory '$_' does not appear to exist.\n";
 164     }
 165     $INC_total++;
 166 }
 167
 168 $label = '@INC directories exist';
 169 if ($INC_total == $INC_there) {
 170     print "ok 3 $label\n";
 171     $pass__total++;
 172 }
 173 else {
 174     print "not ok 3 $label\n";
 175     $error_total++;
 176 }
 177 $tests_total++;
 178
 179
 180 print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
 181
 182 my $needed_total = 0;
 183 my $needed_there = 0;
 184 foreach (qw(Config.pm ExtUtils/Installed.pm)) {
 185     $@ = undef;
 186     $needed_total++;
 187     eval "require \"$_\";";
 188     if (!$@) {
 189         print "## Module '$_' appears to be installed.\n" if $opt{'v'};
 190         $needed_there++;
 191     }
 192     else {
 193         print "# Needed module '$_' does not appear to be properly installed.\n";
 194     }
 195     $@ = undef;
 196 }
 197 $label = 'Modules needed for rest of perlivp exist';
 198 if ($needed_total == $needed_there) {
 199     print "ok 4 $label\n";
 200     $pass__total++;
 201 }
 202 else {
 203     print "not ok 4 $label\n";
 204     $error_total++;
 205 }
 206 $tests_total++;
 207
 208
 209 print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
 210
 211 use Config;
 212
 213 my $extensions_total = 0;
 214 my $extensions_there = 0;
 215 if (defined($Config{'extensions'})) {
 216     my @extensions = split(/\s+/,$Config{'extensions'});
 217     foreach (@extensions) {
 218         next if ($_ eq '');
 219         if ( $useithreads !~ /define/i ) {
 220             next if ($_ eq 'threads');
 221             next if ($_ eq 'threads/shared');
 222         }
 223         # that's a distribution name, not a module name
 224         next if $_ eq 'IO/Compress';
 225         next if $_ eq 'Devel/DProf';
 226         next if $_ eq 'libnet';
 227         next if $_ eq 'Locale/Codes';
 228         next if $_ eq 'podlators';
 229         next if $_ eq 'perlfaq';
 230         # test modules
 231         next if $_ eq 'XS/APItest';
 232         next if $_ eq 'XS/Typemap';
 233            # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
 234            # \NT> perl  -e "eval \"require './Devel/DProf.pm'\"; print $@"
 235            # DProf: run perl with -d to use DProf.
 236            # Compilation failed in require at (eval 1) line 1.
 237         eval " require \"$_.pm\"; ";
 238         if (!$@) {
 239             print "## Module '$_' appears to be installed.\n" if $opt{'v'};
 240             $extensions_there++;
 241         }
 242         else {
 243             print "# Required module '$_' does not appear to be properly installed.\n";
 244             $@ = undef;
 245         }
 246         $extensions_total++;
 247     }
 248
 249     # A silly name for a module (that hopefully won't ever exist).
 250     # Note that this test serves more as a check of the validity of the
 251     # actual required module tests above.
 252     my $unnecessary = 'bLuRfle';
 253
 254     if (!grep(/$unnecessary/, @extensions)) {
 255         $@ = undef;
 256         eval " require \"$unnecessary.pm\"; ";
 257         if ($@) {
 258             print "## Unnecessary module '$unnecessary' does not appear to be installed.\n" if $opt{'v'};
 259         }
 260         else {
 261             print "# Unnecessary module '$unnecessary' appears to be installed.\n";
 262             $extensions_there++;
 263         }
 264     }
 265     $@ = undef;
 266 }
 267 $label = 'All (and only) expected extensions installed';
 268 if ($extensions_total == $extensions_there) {
 269     print "ok 5 $label\n";
 270     $pass__total++;
 271 }
 272 else {
 273     print "not ok 5 $label\n";
 274     $error_total++;
 275 }
 276 $tests_total++;
 277
 278
 279 print "## Checking installations of later additional extensions.\n" if $opt{'p'};
 280
 281 use ExtUtils::Installed;
 282
 283 my $installed_total = 0;
 284 my $installed_there = 0;
 285 my $version_check = 0;
 286 my $installed = ExtUtils::Installed -> new();
 287 my @modules = $installed -> modules();
 288 my @missing = ();
 289 my $version = undef;
 290 for (@modules) {
 291     $installed_total++;
 292     # Consider it there if it contains one or more files,
 293     # and has zero missing files,
 294     # and has a defined version
 295     $version = undef;
 296     $version = $installed -> version($_);
 297     if ($version) {
 298         print "## $_; $version\n" if $opt{'v'};
 299         $version_check++;
 300     }
 301     else {
 302         print "# $_; NO VERSION\n" if $opt{'v'};
 303     }
 304     $version = undef;
 305     @missing = ();
 306     @missing = $installed -> validate($_);
 307
 308     # .bs files are optional
 309     @missing = grep { ! /\.bs$/ } @missing;
 310     # man files are often compressed
 311     @missing = grep { ! ( -s "$_.gz" || -s "$_.bz2" ) } @missing;
 312
 313     if ($#missing >= 0) {
 314         print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 315         print '# ',join(' ',@missing),"\n";
 316     }
 317     elsif ($#missing == -1) {
 318         $installed_there++;
 319     }
 320     @missing = ();
 321 }
 322 $label = 'Module files correctly installed';
 323 if (($installed_total == $installed_there) &&
 324     ($installed_total == $version_check)) {
 325     print "ok 6 $label\n";
 326     $pass__total++;
 327 }
 328 else {
 329     print "not ok 6 $label\n";
 330     $error_total++;
 331 }
 332 $tests_total++;
 333
 334 # Final report (rather than feed ousrselves to Test::Harness::runtests()
 335 # we simply format some output on our own to keep things simple and
 336 # easier to "fix" - at least for now.
 337
 338 if ($error_total == 0 && $tests_total) {
 339     print "All tests successful.\n";
 340 } elsif ($tests_total==0){
 341         die "FAILED--no tests were run for some reason.\n";
 342 } else {
 343     my $rate = 0.0;
 344     if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
 345     printf " %d/%d subtests failed, %.2f%% okay.\n",
 346                               $error_total, $tests_total, $rate;
 347 }
 348
 349 =head1 NAME
 350
 351 perlivp - Perl Installation Verification Procedure
 352
 353 =head1 SYNOPSIS
 354
 355 B<perlivp> [B<-p>] [B<-v>] [B<-h>]
 356
 357 =head1 DESCRIPTION
 358
 359 The B<perlivp> program is set up at Perl source code build time to test the
 360 Perl version it was built under.  It can be used after running:
 361
 362     make install
 363
 364 (or your platform's equivalent procedure) to verify that B<perl> and its
 365 libraries have been installed correctly.  A correct installation is verified
 366 by output that looks like:
 367
 368     ok 1
 369     ok 2
 370
 371 etc.
 372
 373 =head1 OPTIONS
 374
 375 =over 5
 376
 377 =item B<-h> help
 378
 379 Prints out a brief help message.
 380
 381 =item B<-p> print preface
 382
 383 Gives a description of each test prior to performing it.
 384
 385 =item B<-v> verbose
 386
 387 Gives more detailed information about each test, after it has been performed.
 388 Note that any failed tests ought to print out some extra information whether
 389 or not -v is thrown.
 390
 391 =back
 392
 393 =head1 DIAGNOSTICS
 394
 395 =over 4
 396
 397 =item * print "# Perl binary '$perlpath' does not appear executable.\n";
 398
 399 Likely to occur for a perl binary that was not properly installed.
 400 Correct by conducting a proper installation.
 401
 402 =item * print "# Perl version '$]' installed, expected $ivp_VERSION.\n";
 403
 404 Likely to occur for a perl that was not properly installed.
 405 Correct by conducting a proper installation.
 406
 407 =item * print "# Perl \@INC directory '$_' does not appear to exist.\n";
 408
 409 Likely to occur for a perl library tree that was not properly installed.
 410 Correct by conducting a proper installation.
 411
 412 =item * print "# Needed module '$_' does not appear to be properly installed.\n";
 413
 414 One of the two modules that is used by perlivp was not present in the
 415 installation.  This is a serious error since it adversely affects perlivp's
 416 ability to function.  You may be able to correct this by performing a
 417 proper perl installation.
 418
 419 =item * print "# Required module '$_' does not appear to be properly installed.\n";
 420
 421 An attempt to C<eval "require $module"> failed, even though the list of
 422 extensions indicated that it should succeed.  Correct by conducting a proper
 423 installation.
 424
 425 =item * print "# Unnecessary module 'bLuRfle' appears to be installed.\n";
 426
 427 This test not coming out ok could indicate that you have in fact installed
 428 a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
 429 test may give misleading results with your installation of perl.  If yours
 430 is the latter case then please let the author know.
 431
 432 =item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 433
 434 One or more files turned up missing according to a run of
 435 C<ExtUtils::Installed -E<gt> validate()> over your installation.
 436 Correct by conducting a proper installation.
 437
 438 =back
 439
 440 For further information on how to conduct a proper installation consult the
 441 INSTALL file that comes with the perl source and the README file for your
 442 platform.
 443
 444 =head1 AUTHOR
 445
 446 Peter Prymmer
 447
 448 =cut
 449
 450 !NO!SUBS!
 451
 452 close OUT or die "Can't close $file: $!";
 453 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 454 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
 455 chdir $origdir;
 456