Reindent a section of the file.
[p5sagit/p5-mst-13.2.git] / utils / perlivp.PL
CommitLineData
cdf8b154 1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename;
5use 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.
345d73cf 17my $origdir = cwd;
cdf8b154 18chdir dirname($0);
345d73cf 19my $file = basename($0, '.PL');
cdf8b154 20$file .= '.com' if $^O eq 'VMS';
21
22# Create output file.
23open OUT,">$file" or die "Can't create $file: $!";
24
25print "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
30print 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
38print OUT <<'!NO!SUBS!';
39
345d73cf 40# perlivp V 0.02
cdf8b154 41
42
43sub usage {
44 warn "@_\n" if @_;
45 print << " EOUSAGE";
46Usage:
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
345d73cf 59use vars qw(%opt); # allow testing with older versions (do not use our)
cdf8b154 60
61@opt{ qw/? H h P p V v/ } = qw(0 0 0 0 0 0 0);
62
63while ($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
78my $pass__total = 0;
79my $error_total = 0;
80my $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.
86my $perlpath = '';
87if (defined($Config{'perlpath'})) { $perlpath = $Config{'perlpath'}; }
cdf8b154 88
345d73cf 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.
92my $useithreads = '';
93if (defined($Config{'useithreads'})) { $useithreads = $Config{'useithreads'}; }
94
cdf8b154 95print OUT <<"!GROK!THIS!";
96my \$perlpath = '$perlpath';
345d73cf 97my \$useithreads = '$useithreads';
cdf8b154 98!GROK!THIS!
99
100print OUT <<'!NO!SUBS!';
101
102print "## Checking Perl binary via variable `\$perlpath' = $perlpath.\n" if $opt{'p'};
103
104if (-x $perlpath) {
105 print "## Perl binary `$perlpath' appears executable.\n" if $opt{'v'};
106 print "ok 1\n";
107 $pass__total++;
108}
109else {
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
117print "## Checking Perl version via variable `\$]'.\n" if $opt{'p'};
118
119!NO!SUBS!
120
121print OUT <<"!GROK!THIS!";
122my \$ivp_VERSION = $];
123
124!GROK!THIS!
125print OUT <<'!NO!SUBS!';
126if ($ivp_VERSION == $]) {
127 print "## Perl version `$]' appears installed as expected.\n" if $opt{'v'};
128 print "ok 2\n";
129 $pass__total++;
130}
131else {
132 print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
133 print "not ok 2\n";
134 $error_total++;
135}
136$tests_total++;
137
138
139print "## Checking roots of the Perl library directory tree via variable `\@INC'.\n" if $opt{'p'};
140
141my $INC_total = 0;
142my $INC_there = 0;
143foreach (@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}
158if ($INC_total == $INC_there) {
159 print "ok 3\n";
160 $pass__total++;
161}
162else {
163 print "not ok 3\n";
164 $error_total++;
165}
166$tests_total++;
167
168
169print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
170
171my $needed_total = 0;
172my $needed_there = 0;
173foreach (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 {
e46df07c 182 print "# Needed module `$_' does not appear to be properly installed.\n";
cdf8b154 183 }
184 $@ = undef;
185}
186if ($needed_total == $needed_there) {
187 print "ok 4\n";
188 $pass__total++;
189}
190else {
191 print "not ok 4\n";
192 $error_total++;
193}
194$tests_total++;
195
196
197print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
198
199use Config;
200
201my $extensions_total = 0;
202my $extensions_there = 0;
203if (defined($Config{'extensions'})) {
204 my @extensions = split(/\s+/,$Config{'extensions'});
205 foreach (@extensions) {
206 next if ($_ eq '');
345d73cf 207 if ( $useithreads !~ /define/i ) {
208 next if ($_ eq 'threads');
209 next if ($_ eq 'threads/shared');
210 }
cdf8b154 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 {
e46df07c 222 print "# Required module `$_' does not appear to be properly installed.\n";
cdf8b154 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}
246if ($extensions_total == $extensions_there) {
247 print "ok 5\n";
248 $pass__total++;
249}
250else {
251 print "not ok 5\n";
252 $error_total++;
253}
254$tests_total++;
255
256
257print "## Checking installations of later additional extensions.\n" if $opt{'p'};
258
259use ExtUtils::Installed;
260
261my $installed_total = 0;
262my $installed_there = 0;
263my $version_check = 0;
264my $installed = ExtUtils::Installed -> new();
265my @modules = $installed -> modules();
266my @missing = ();
267my $version = undef;
268for (@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}
294if (($installed_total == $installed_there) &&
295 ($installed_total == $version_check)) {
296 print "ok 6\n";
297 $pass__total++;
298}
299else {
300 print "not ok 6\n";
301 $error_total++;
302}
303$tests_total++;
304
305
306print "## Checking installations of *.h -> *.ph header files.\n" if $opt{'p'};
307my $ph_there = 0;
308my $var = undef;
309my $val = undef;
310my $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).
313my @ph_files = qw(stdio.ph);
314# Add the ones that we know that perl thinks are there:
315while (($var, $val) = each %Config) {
316 if ($var =~ m/i_(.+)/ && $val eq 'define') {
317 $h_file = $1;
07853d7a 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';
30111f48 325 $h_file = 'rpcsvc/dbm' if $h_file eq 'rpcsvcdbm';
cdf8b154 326 # This ought to distinguish syslog from sys/syslog.
327 # (NB syslog.ph is heavily used for the DBI pre-requisites).
07853d7a 328 $h_file =~ s{^sys(\w.+)}{sys/$1} unless $h_file eq 'syslog';
cdf8b154 329 push(@ph_files, "$h_file.ph");
330 }
331}
332#foreach (qw(stdio.ph syslog.ph)) {
333foreach (@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 {
e46df07c 341 print "# Perl header `$_' does not appear to be properly installed.\n";
cdf8b154 342 }
343 $@ = undef;
344}
345
346if (scalar(@ph_files) == $ph_there) {
347 print "ok 7\n";
348 $pass__total++;
349}
350else {
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
360if ($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
373B<perlivp> - Perl Installation Verification Procedure
374
375=head1 SYNOPSIS
376
377B<perlivp> [B<-p>] [B<-v>] [B<-h>]
378
379=head1 DESCRIPTION
380
381The B<perlivp> program is set up at Perl source code build time to test the
382Perl 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
387libraries have been installed correctly. A correct installation is verified
388by output that looks like:
389
390 ok 1
391 ok 2
392
393etc.
394
395=head1 OPTIONS
396
397=over 5
398
399=item B<-h> help
400
401Prints out a brief help message.
402
403=item B<-p> print preface
404
405Gives a description of each test prior to performing it.
406
407=item B<-v> verbose
408
409Gives more detailed information about each test, after it has been performed.
410Note that any failed tests ought to print out some extra information whether
411or 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
421Likely to occur for a perl binary that was not properly installed.
422Correct by conducting a proper installation.
423
424=item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
425
426Likely to occur for a perl that was not properly installed.
427Correct by conducting a proper installation.
428
429=item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
430
431Likely to occur for a perl library tree that was not properly installed.
432Correct by conducting a proper installation.
433
434=item * print "# Needed module `$_' does not appear to be properly installed.\n";
435
436One of the two modules that is used by perlivp was not present in the
437installation. This is a serious error since it adversely affects perlivp's
438ability to function. You may be able to correct this by performing a
439proper perl installation.
440
441=item * print "# Required module `$_' does not appear to be properly installed.\n";
442
443An attempt to C<eval "require $module"> failed, even though the list of
444extensions indicated that it should succeed. Correct by conducting a proper
445installation.
446
447=item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
448
449This test not coming out ok could indicate that you have in fact installed
450a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
451test may give misleading results with your installation of perl. If yours
452is the latter case then please let the author know.
453
454=item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
455
456One or more files turned up missing according to a run of
457C<ExtUtils::Installed -E<gt> validate()> over your installation.
458Correct by conducting a proper installation.
459
460=item * print "# Perl header `$_' does not appear to be properly installed.\n";
461
462Correct by running B<h2ph> over your system's C header files. If necessary,
463edit the resulting *.ph files to eliminate perl syntax errors.
464
465=back
466
467For further information on how to conduct a proper installation consult the
468INSTALL file that comes with the perl source and the README file for your
469platform.
470
471=head1 AUTHOR
472
473Peter Prymmer
474
475=cut
476
477!NO!SUBS!
478
479close OUT or die "Can't close $file: $!";
480chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
481exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
482chdir $origdir;
483