AIX doesn't set the length in getsockopt.
[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 [-p] [-v] | [-h]
48
49     -p Print a preface before each test telling what it will test.
50     -v Verbose mode in which extra information about test results
51        is printed.  Test failures always print out some extra information
52        regardless of whether or not this switch is set.
53     -h Prints this help message.
54     EOUSAGE
55     exit;
56 }
57
58 use vars qw(%opt); # allow testing with older versions (do not use our)
59
60 @opt{ qw/? H h P p V v/ } = qw(0 0 0 0 0 0 0);
61
62 while ($ARGV[0] =~ /^-/) {
63     $ARGV[0] =~ s/^-//; 
64     for my $flag (split(//,$ARGV[0])) {
65         usage() if '?' =~ /\Q$flag/;
66         usage() if 'h' =~ /\Q$flag/;
67         usage() if 'H' =~ /\Q$flag/;
68         usage("unknown flag: '$flag'") unless 'HhPpVv' =~ /\Q$flag/;
69         warn "$0: '$flag' flag already set\n" if $opt{$flag}++;
70     } 
71     shift;
72 }
73
74 $opt{p}++ if $opt{P};
75 $opt{v}++ if $opt{V};
76
77 my $pass__total = 0;
78 my $error_total = 0;
79 my $tests_total = 0;
80
81 !NO!SUBS!
82
83 # We cannot merely check the variable '$^X' in general since on many 
84 # Unixes it is the basename rather than the full path to the perl binary.
85 my $perlpath = '';
86 if (defined($Config{'perlpath'})) { $perlpath = $Config{'perlpath'}; }
87
88 # The useithreads Config variable plays a role in whether or not
89 # threads and threads/shared work when C<use>d.  They apparently always
90 # get installed on systems that can run Configure.
91 my $useithreads = '';
92 if (defined($Config{'useithreads'})) { $useithreads = $Config{'useithreads'}; }
93
94 print OUT <<"!GROK!THIS!";
95 my \$perlpath = '$perlpath';
96 my \$useithreads = '$useithreads';
97 !GROK!THIS!
98
99 print OUT <<'!NO!SUBS!';
100
101 print "## Checking Perl binary via variable '\$perlpath' = $perlpath.\n" if $opt{'p'};
102
103 my $label = 'Executable perl binary';
104
105 if (-x $perlpath) {
106     print "## Perl binary '$perlpath' appears executable.\n" if $opt{'v'};
107     print "ok 1 $label\n";
108     $pass__total++;
109 }
110 else {
111     print "# Perl binary '$perlpath' does not appear executable.\n";
112     print "not ok 1 $label\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
128 $label = 'Perl version correct';
129 if ($ivp_VERSION eq $]) {
130     print "## Perl version '$]' appears installed as expected.\n" if $opt{'v'};
131     print "ok 2 $label\n";
132     $pass__total++;
133 }
134 else {
135     print "# Perl version '$]' installed, expected $ivp_VERSION.\n";
136     print "not ok 2 $label\n";
137     $error_total++;
138 }
139 $tests_total++;
140
141 # We have the right perl and version, so now reset @INC so we ignore
142 # PERL5LIB and '.'
143 {
144     local $ENV{PERL5LIB};
145     my $perl_V = qx($perlpath -V);
146     $perl_V =~ s{.*\@INC:\n}{}ms;
147     @INC = grep { length && $_ ne '.' } split ' ', $perl_V;
148 }
149
150 print "## Checking roots of the Perl library directory tree via variable '\@INC'.\n" if $opt{'p'};
151
152 my $INC_total = 0;
153 my $INC_there = 0;
154 foreach (@INC) {
155     next if $_ eq '.'; # skip -d test here
156     if (-d $_) {
157         print "## Perl \@INC directory '$_' exists.\n" if $opt{'v'};
158         $INC_there++;
159     }
160     else {
161         print "# Perl \@INC directory '$_' does not appear to exist.\n";
162     }
163     $INC_total++;
164 }
165
166 $label = '@INC directoreis exist';
167 if ($INC_total == $INC_there) {
168     print "ok 3 $label\n";
169     $pass__total++;
170 }
171 else {
172     print "not ok 3 $label\n";
173     $error_total++;
174 }
175 $tests_total++;
176
177
178 print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
179
180 my $needed_total = 0;
181 my $needed_there = 0;
182 foreach (qw(Config.pm ExtUtils/Installed.pm)) {
183     $@ = undef;
184     $needed_total++;
185     eval "require \"$_\";";
186     if (!$@) {
187         print "## Module '$_' appears to be installed.\n" if $opt{'v'};
188         $needed_there++;
189     }
190     else {
191         print "# Needed module '$_' does not appear to be properly installed.\n";
192     }
193     $@ = undef;
194 }
195 $label = 'Modules needed for rest of perlivp exist';
196 if ($needed_total == $needed_there) {
197     print "ok 4 $label\n";
198     $pass__total++;
199 }
200 else {
201     print "not ok 4 $label\n";
202     $error_total++;
203 }
204 $tests_total++;
205
206
207 print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
208
209 use Config;
210
211 my $extensions_total = 0;
212 my $extensions_there = 0;
213 if (defined($Config{'extensions'})) {
214     my @extensions = split(/\s+/,$Config{'extensions'});
215     foreach (@extensions) {
216         next if ($_ eq '');
217         if ( $useithreads !~ /define/i ) {
218             next if ($_ eq 'threads');
219             next if ($_ eq 'threads/shared');
220         }
221         # that's a distribution name, not a module name
222         next if $_ eq 'IO/Compress';
223         next if $_ eq 'Devel/DProf';
224         next if $_ eq 'libnet';
225         next if $_ eq 'Locale/Codes';
226         next if $_ eq 'podlators';
227         next if $_ eq 'perlfaq';
228         # test modules
229         next if $_ eq 'XS/APItest';
230         next if $_ eq 'XS/Typemap';
231            # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
232            # \NT> perl  -e "eval \"require 'Devel/DProf.pm'\"; print $@"
233            # DProf: run perl with -d to use DProf.
234            # Compilation failed in require at (eval 1) line 1.
235         eval " require \"$_.pm\"; ";
236         if (!$@) {
237             print "## Module '$_' appears to be installed.\n" if $opt{'v'};
238             $extensions_there++;
239         }
240         else {
241             print "# Required module '$_' does not appear to be properly installed.\n";
242             $@ = undef;
243         }
244         $extensions_total++;
245     }
246
247     # A silly name for a module (that hopefully won't ever exist).
248     # Note that this test serves more as a check of the validity of the
249     # actual required module tests above.
250     my $unnecessary = 'bLuRfle';
251
252     if (!grep(/$unnecessary/, @extensions)) {
253         $@ = undef;
254         eval " require \"$unnecessary.pm\"; ";
255         if ($@) {
256             print "## Unnecessary module '$unnecessary' does not appear to be installed.\n" if $opt{'v'};
257         }
258         else {
259             print "# Unnecessary module '$unnecessary' appears to be installed.\n";
260             $extensions_there++;
261         }
262     }
263     $@ = undef;
264 }
265 $label = 'All (and only) expected extensions installed';
266 if ($extensions_total == $extensions_there) {
267     print "ok 5 $label\n";
268     $pass__total++;
269 }
270 else {
271     print "not ok 5 $label\n";
272     $error_total++;
273 }
274 $tests_total++;
275
276
277 print "## Checking installations of later additional extensions.\n" if $opt{'p'};
278
279 use ExtUtils::Installed;
280
281 my $installed_total = 0;
282 my $installed_there = 0;
283 my $version_check = 0;
284 my $installed = ExtUtils::Installed -> new();
285 my @modules = $installed -> modules();
286 my @missing = ();
287 my $version = undef;
288 for (@modules) {
289     $installed_total++;
290     # Consider it there if it contains one or more files,
291     # and has zero missing files,
292     # and has a defined version
293     $version = undef;
294     $version = $installed -> version($_);
295     if ($version) {
296         print "## $_; $version\n" if $opt{'v'};
297         $version_check++;
298     }
299     else {
300         print "# $_; NO VERSION\n" if $opt{'v'};
301     }
302     $version = undef;
303     @missing = ();
304     @missing = $installed -> validate($_);
305
306     # .bs files are optional
307     @missing = grep { ! /\.bs$/ } @missing;
308     # man files are often compressed
309     @missing = grep { ! ( -s "$_.gz" || -s "$_.bz2" ) } @missing;
310
311     if ($#missing >= 0) {
312         print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
313         print '# ',join(' ',@missing),"\n";
314     }
315     elsif ($#missing == -1) {
316         $installed_there++;
317     }
318     @missing = ();
319 }
320 $label = 'Module files correctly installed';
321 if (($installed_total == $installed_there) && 
322     ($installed_total == $version_check)) {
323     print "ok 6 $label\n";
324     $pass__total++;
325 }
326 else {
327     print "not ok 6 $label\n";
328     $error_total++;
329 }
330 $tests_total++;
331
332 # Final report (rather than feed ousrselves to Test::Harness::runtests()
333 # we simply format some output on our own to keep things simple and
334 # easier to "fix" - at least for now.
335
336 if ($error_total == 0 && $tests_total) {
337     print "All tests successful.\n";
338 } elsif ($tests_total==0){
339         die "FAILED--no tests were run for some reason.\n";
340 } else {
341     my $rate = 0.0;
342     if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
343     printf " %d/%d subtests failed, %.2f%% okay.\n",
344                               $error_total, $tests_total, $rate;
345 }
346
347 =head1 NAME
348
349 perlivp - Perl Installation Verification Procedure
350
351 =head1 SYNOPSIS
352
353 B<perlivp> [B<-p>] [B<-v>] [B<-h>]
354
355 =head1 DESCRIPTION
356
357 The B<perlivp> program is set up at Perl source code build time to test the
358 Perl version it was built under.  It can be used after running:
359
360     make install
361
362 (or your platform's equivalent procedure) to verify that B<perl> and its
363 libraries have been installed correctly.  A correct installation is verified
364 by output that looks like:
365
366     ok 1
367     ok 2
368
369 etc.
370
371 =head1 OPTIONS
372
373 =over 5
374
375 =item B<-h> help
376
377 Prints out a brief help message.
378
379 =item B<-p> print preface
380
381 Gives a description of each test prior to performing it.
382
383 =item B<-v> verbose
384
385 Gives more detailed information about each test, after it has been performed.
386 Note that any failed tests ought to print out some extra information whether
387 or not -v is thrown.
388
389 =back
390
391 =head1 DIAGNOSTICS
392
393 =over 4
394
395 =item * print "# Perl binary '$perlpath' does not appear executable.\n";
396
397 Likely to occur for a perl binary that was not properly installed.
398 Correct by conducting a proper installation.
399
400 =item * print "# Perl version '$]' installed, expected $ivp_VERSION.\n";
401
402 Likely to occur for a perl that was not properly installed.
403 Correct by conducting a proper installation.
404
405 =item * print "# Perl \@INC directory '$_' does not appear to exist.\n";
406
407 Likely to occur for a perl library tree that was not properly installed.
408 Correct by conducting a proper installation.
409
410 =item * print "# Needed module '$_' does not appear to be properly installed.\n";
411
412 One of the two modules that is used by perlivp was not present in the 
413 installation.  This is a serious error since it adversely affects perlivp's
414 ability to function.  You may be able to correct this by performing a
415 proper perl installation.
416
417 =item * print "# Required module '$_' does not appear to be properly installed.\n";
418
419 An attempt to C<eval "require $module"> failed, even though the list of 
420 extensions indicated that it should succeed.  Correct by conducting a proper 
421 installation.
422
423 =item * print "# Unnecessary module 'bLuRfle' appears to be installed.\n";
424
425 This test not coming out ok could indicate that you have in fact installed 
426 a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
427 test may give misleading results with your installation of perl.  If yours
428 is the latter case then please let the author know.
429
430 =item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
431
432 One or more files turned up missing according to a run of 
433 C<ExtUtils::Installed -E<gt> validate()> over your installation.
434 Correct by conducting a proper installation.
435
436 =back
437
438 For further information on how to conduct a proper installation consult the 
439 INSTALL file that comes with the perl source and the README file for your 
440 platform.
441
442 =head1 AUTHOR
443
444 Peter Prymmer
445
446 =cut
447
448 !NO!SUBS!
449
450 close OUT or die "Can't close $file: $!";
451 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
452 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
453 chdir $origdir;
454