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