Documentation fix
[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 (-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