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