This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
toke.c: Recognize "0odddd" octal literals.
[perl5.git] / t / porting / regen.t
CommitLineData
3879ea51
NC
1#!./perl -w
2
3# Verify that all files generated by perl scripts are up to date.
4
3879ea51 5BEGIN {
208c2b59 6 @INC = '..' if -f '../TestInit.pm';
3879ea51 7}
208c2b59 8use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute
3879ea51
NC
9use strict;
10
3d7c117d
MB
11require './regen/regen_lib.pl';
12require './t/test.pl';
c24c946d
NC
13$::NO_ENDING = $::NO_ENDING = 1;
14
b511b76c
CB
15if ( $^O eq "VMS" ) {
16 skip_all( "- regen.pl needs porting." );
17}
fa2edc1a
JH
18if ($^O eq 'dec_osf') {
19 skip_all("$^O cannot handle this test");
20}
ff23b6f8
KW
21if ( $::IS_EBCDIC || $::IS_EBCDIC) {
22 skip_all( "- We don't regen on EBCDIC." );
23}
3a73a075
BF
24use Config;
25if ( $Config{usecrosscompile} ) {
26 skip_all( "Not all files are available during cross-compilation" );
27}
b511b76c 28
8c3a0f6c 29my $tests = 25; # I can't see a clean way to calculate this automatically.
c24c946d 30
0daf6d09
NC
31my %skip = ("regen_perly.pl" => [qw(perly.act perly.h perly.tab)],
32 "regen/keywords.pl" => [qw(keywords.c keywords.h)],
33 "regen/uconfig_h.h" => [qw(uconfig.h)],
3e376abb 34 "regen/mk_invlists.pl" => [qw(charclass_invlists.h uni_keywords.h)],
542a7545 35 "regen/regcharclass.pl" => [qw(regcharclass.h)],
0daf6d09
NC
36 );
37
5e39bfe1
AC
38my %other_requirement = (
39 "regen_perly.pl" => "requires bison",
40 "regen/keywords.pl" => "requires Devel::Tokenizer::C",
41 "regen/mk_invlists.pl" => "needs the Perl you've just built",
42 "regen/regcharclass.pl" => "needs the Perl you've just built",
43);
44
b7a02455
AC
45my %skippable_script_for_target;
46for my $script (keys %other_requirement) {
47 $skippable_script_for_target{$_} = $script
48 for @{ $skip{$script} };
49}
50
0daf6d09
NC
51my @files = map {@$_} sort values %skip;
52
53open my $fh, '<', 'regen.pl'
54 or die "Can't open regen.pl: $!";
55
56while (<$fh>) {
57 last if /^__END__/;
58}
59die "Can't find __END__ in regen.pl"
60 if eof $fh;
61
62foreach (qw(embed_lib.pl regen_lib.pl uconfig_h.pl
6ff677df
KW
63 regcharclass_multi_char_folds.pl
64 charset_translations.pl
1a4d3814 65 mph.pl
6ff677df 66 ),
0daf6d09
NC
67 map {chomp $_; $_} <$fh>) {
68 ++$skip{"regen/$_"};
69}
70
71close $fh
72 or die "Can't close regen.pl: $!";
73
74my @progs = grep {!$skip{$_}} <regen/*.pl>;
75push @progs, 'regen.pl', map {"Porting/makemeta $_"} qw(-j -y);
76
77plan (tests => $tests + @files + @progs);
c24c946d
NC
78
79OUTER: foreach my $file (@files) {
80 open my $fh, '<', $file or die "Can't open $file: $!";
81 1 while defined($_ = <$fh>) and !/Generated from:/;
82 if (eof $fh) {
83 fail("Can't find 'Generated from' line in $file");
84 next;
85 }
86 my @bad;
87 while (<$fh>) {
88 last if /ex: set ro:/;
89 unless (/^(?: \* | #)([0-9a-f]+) (\S+)$/) {
90 chomp $_;
91 fail("Bad line in $file: '$_'");
92 next OUTER;
93 }
ff23b6f8 94
c24c946d
NC
95 my $digest = digest($2);
96 note("$digest $2");
97 push @bad, $2 unless $digest eq $1;
98 }
99 is("@bad", '', "generated $file is up to date");
b7a02455
AC
100 if (@bad && (my $skippable_script = $skippable_script_for_target{$file})) {
101 my $reason = delete $other_requirement{$skippable_script};
102 diag("Note: $skippable_script must be run manually, because it $reason")
103 if $reason;
5e39bfe1 104 }
c24c946d 105}
3879ea51 106
0daf6d09 107foreach (@progs) {
1fb364e9 108 my $args = qq[-Ilib $_ --tap];
28cd6515 109 note("./perl $args");
1fb364e9 110 my $command = "$^X $args";
0daf6d09 111 system $command
1fb364e9
N
112 and die <<~"HINT";
113 Hint: A failure in this file can often be corrected by running:
114 ./perl -Ilib $_
115HINT
bfc0a3e7 116}