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