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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
#!./perl -w
# Verify that all files generated by perl scripts are up to date.
BEGIN {
push @INC, '..' if -f '../TestInit.pm';
push @INC, '.' if -f './TestInit.pm';
}
use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute
use strict;
require './regen/regen_lib.pl';
require './t/test.pl';
$::NO_ENDING = $::NO_ENDING = 1;
if ( $^O eq "VMS" ) {
skip_all( "- regen.pl needs porting." );
}
if ($^O eq 'dec_osf') {
skip_all("$^O cannot handle this test");
}
if ( $::IS_EBCDIC || $::IS_EBCDIC) {
skip_all( "- We don't regen on EBCDIC." );
}
use Config;
if ( $Config{usecrosscompile} ) {
skip_all( "Not all files are available during cross-compilation" );
}
my $tests = 28; # I can't see a clean way to calculate this automatically.
my %skip = ("regen_perly.pl" => [qw(perly.act perly.h perly.tab)],
"regen/keywords.pl" => [qw(keywords.c keywords.h)],
"regen/mk_invlists.pl" => [qw(charclass_invlists.inc regexp_constants.h uni_keywords.h)],
"regen/regcharclass.pl" => [qw(regcharclass.h)],
);
my %other_requirement = (
"regen_perly.pl" => "requires bison",
"regen/keywords.pl" => "requires Devel::Tokenizer::C",
"regen/mk_invlists.pl" => "needs the Perl you've just built",
"regen/regcharclass.pl" => "needs the Perl you've just built",
);
my %skippable_script_for_target;
for my $script (keys %other_requirement) {
$skippable_script_for_target{$_} = $script
for @{ $skip{$script} };
}
my @files = map {@$_} sort values %skip;
# find out what regen scripts would be executed by regen.pl which
# is the script that implements `make regen`. We need to know this
# because we will run regen.pl --tap, and it will in turn
# so we don't need to execute the scripts it executes directly.
my %regen_files;
{
open my $fh, '<', 'regen.pl'
or die "Can't open regen.pl: $!";
while (<$fh>) {
last if /^__END__/;
}
die "Can't find __END__ in regen.pl"
if eof $fh;
while (<$fh>) {
chomp $_;
++$regen_files{$_};
}
close $fh
or die "Can't close regen.pl: $!";
}
# This may look a bit weird but it makes sense. We build a skip hash of
# all the scripts that we want to avoid executing /explicitly/ during
# our tests. This includes the files listed in %regen_files because we
# will execute them via regen.pl instead.
foreach (
qw(
charset_translations.pl
embed_lib.pl
mph.pl
regcharclass_multi_char_folds.pl
regen_lib.pl
sorted_types.pl
),
keys %regen_files
) {
++$skip{"regen/$_"};
}
my @progs = grep {!$skip{$_}} <regen/*.pl>;
push @progs, 'regen.pl', map {"Porting/makemeta $_"} qw(-j -y);
@progs = sort @progs;
plan (tests => $tests + @files + @progs);
OUTER: foreach my $file (@files) {
open my $fh, '<', $file or die "Can't open $file: $!";
1 while defined($_ = <$fh>) and !/Generated from:/;
if (eof $fh) {
fail("Can't find 'Generated from' line in $file");
next;
}
my @bad;
while (<$fh>) {
last if /ex:[^:]+:/;
unless (/^(?: \* | #)([0-9a-f]+) (\S+)$/) {
chomp $_;
fail("Bad line in $file: '$_'");
next OUTER;
}
my $digest = digest($2);
note("$digest $2");
push @bad, $2 unless $digest eq $1;
}
is("@bad", '', "generated $file is up to date");
if (@bad && (my $skippable_script = $skippable_script_for_target{$file})) {
my $reason = delete $other_requirement{$skippable_script};
diag("Note: $skippable_script must be run manually, because it $reason")
if $reason;
}
}
my @errors;
foreach my $prog (@progs) {
my $args = qq[-Ilib $prog --tap];
note("./perl $args");
my $command = "$^X $args";
if (system $command) { # if it exits with an error...
$command=~s/\s*--tap//;
push @errors, $prog eq "regen.pl"
? "make regen"
: $command;
}
}
if ( @errors ) {
my $commands= join "\n", sort @errors;
die "\n\nERROR. There are generated files which are NOT up to date.\n",
"You should run the following commands to update these files:\n\n",
$commands, "\n\n",
"Once they are regenerated you should commit the changes.\n\n";
}
|
