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