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