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