This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/lib/common.pl should use absolute paths in @INC
[perl5.git] / t / lib / common.pl
1 # This code is used by lib/charnames.t, lib/croak.t, lib/feature.t,
2 # lib/subs.t, lib/strict.t and lib/warnings.t
3 #
4 # On input, $::local_tests is the number of tests in the caller; or
5 # 'no_plan' if unknown, in which case it is the caller's responsibility
6 # to call cur_test() to find out how many this executed
7
8 BEGIN {
9     require './test.pl';
10 }
11
12 use Config;
13 use File::Path;
14 use File::Spec::Functions qw(catfile curdir rel2abs);
15
16 use strict;
17 use warnings;
18 my (undef, $file) = caller;
19 my ($pragma_name) = $file =~ /([A-Za-z_0-9]+)\.t$/
20     or die "Can't identify pragama to test from file name '$file'";
21
22 $| = 1;
23
24 my @prgs = () ;
25 my @w_files = () ;
26
27 if (@ARGV)
28   { print "ARGV = [@ARGV]\n" ;
29       @w_files = map { s#^#./lib/$pragma_name/#; $_ } @ARGV
30   }
31 else
32   { @w_files = sort glob(catfile(curdir(), "lib", $pragma_name, "*")) }
33
34 my $files = 0;
35 foreach my $file (@w_files) {
36
37     next if $file =~ /(~|\.orig|,v)$/;
38     next if $file =~ /perlio$/ && !(find PerlIO::Layer 'perlio');
39     next if -d $file;
40
41     open my $fh, '<', $file or die "Cannot open $file: $!\n" ;
42     my $line = 0;
43     while (<$fh>) {
44         $line++;
45         last if /^__END__/ ;
46     }
47
48     {
49         local $/ = undef;
50         $files++;
51         @prgs = (@prgs, $file, split "\n########\n", <$fh>) ;
52     }
53     close $fh;
54 }
55
56 $^X = rel2abs($^X);
57 @INC = map { rel2abs($_) } @INC;
58 my $tempdir = tempfile;
59
60 mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
61 chdir $tempdir or die die "Can't chdir '$tempdir': $!";
62 my $cleanup = 1;
63
64 END {
65     if ($cleanup) {
66         chdir '..' or die "Couldn't chdir .. for cleanup: $!";
67         rmtree($tempdir);
68     }
69 }
70
71 local $/ = undef;
72
73 my $tests = $::local_tests || 0;
74 $tests = scalar(@prgs)-$files + $tests if $tests !~ /\D/;
75 plan $tests;    # If input is 'no_plan', pass it on unchanged
76
77 run_multiple_progs('../..', @prgs);
78
79 1;